1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of guix-forge.
;;;
;;; guix-forge is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published
;;; by the Free Software Foundation, either version 3 of the License,
;;; or (at your option) any later version.
;;;
;;; guix-forge is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guix-forge. If not, see
;;; <https://www.gnu.org/licenses/>.
(define-module (forge webhook)
#:use-module (srfi srfi-1)
#:use-module (gnu build linux-container)
#:use-module ((gnu packages admin) #:select (shadow))
#:use-module ((gnu packages guile) #:select (guile-json-4))
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system accounts)
#:use-module (gnu system file-systems)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module (guix least-authority)
#:use-module (guix build-system go)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (forge socket)
#:export (webhook-service-type
webhook-configuration
webhook-configuration?
webhook-configuration-package
webhook-configuration-socket
webhook-configuration-log-directory
webhook-configuration-hooks
webhook-hook
webhook-hook?
webhook-hook-id
webhook-hook-run))
(define webhook
(package
(name "webhook")
(version "2.8.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/adnanh/webhook")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"0n03xkgwpzans0cymmzb0iiks8mi2c76xxdak780dk0jbv6qgp5i"))))
(build-system go-build-system)
(arguments
`(#:import-path "github.com/adnanh/webhook"
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'configure
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "src/github.com/adnanh/webhook/webhook_test.go"
(("/bin/echo")
(string-append (assoc-ref inputs "coreutils")
"/bin/echo"))))))))
(home-page "https://github.com/adnanh/webhook")
(synopsis "Lightweight incoming webhook server")
(description "webhook is a lightweight configurable tool written
in Go, that allows you to easily create HTTP endpoints (hooks) on your
server, which you can use to execute configured commands. You can also
pass data from the HTTP request (such as headers, payload or query
variables) to your commands. webhook also allows you to specify rules
which have to be satisfied in order for the hook to be triggered.
For example, if you're using Github or Bitbucket, you can use webhook
to set up a hook that runs a redeploy script for your project on your
staging server, whenever you push changes to the master branch of your
project.
If you use Mattermost or Slack, you can set up an \"Outgoing webhook
integration\" or \"Slash command\" to run various commands on your
server, which can then report back directly to you or your channels
using the \"Incoming webhook integrations\", or the appropriate
response body.
webhook aims to do nothing more than it should do, and that is:
@itemize
@item receive the request,
@item parse the headers, payload and query variables,
@item check if the specified rules for the hook are satisfied,
@item and finally, pass the specified arguments to the specified
command via command line arguments or via environment variables.
@end itemize
Everything else is the responsibility of the command's author.")
(license license:expat)))
(define-record-type* <webhook-configuration>
webhook-configuration make-webhook-configuration
webhook-configuration?
(package webhook-configuration-package
(default webhook))
(socket webhook-configuration-socket
(default (forge-ip-socket
(ip "127.0.0.1")
(port 9000))))
(log-directory webhook-configuration-log-directory
(default "/var/log/webhook"))
(hooks webhook-configuration-hooks
(default '())))
(define-record-type* <webhook-hook>
webhook-hook make-webhook-hook
webhook-hook?
(id webhook-hook-id)
(run webhook-hook-run))
(define %webhook-accounts
(list (user-account
(name "webhook")
(group "webhook")
(system? #t)
(comment "webhook user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))
(user-group
(name "webhook")
(system? #t))))
(define (webhook-activation config)
(match-record config <webhook-configuration>
(log-directory)
#~(begin
;; Create log directory and set permissions.
(mkdir-p #$log-directory)
(let ((user (getpw "webhook")))
(for-each (lambda (file)
(chown file (passwd:uid user) (passwd:gid user)))
(find-files #$log-directory #:directories? #t))))))
(define (hooks-json-gexp config)
(with-extensions (list guile-json-4)
#~(begin
(use-modules (srfi srfi-26)
(json))
(call-with-output-file #$output
(cut scm->json
;; We convert from list to vector on the build-side
;; because a vector cannot be lowered correctly into a
;; G-expression.
(list->vector
;; We build a true dotted association list in this
;; roundabout way because a true dotted association
;; list cannot be lowered correctly into a
;; G-expression.
(map (cut map (cut apply cons <>) <>)
'#$(map (lambda (hook)
`(("id" ,(webhook-hook-id hook))
("execute-command" ,(program-file (string-append (webhook-hook-id hook)
"-webhook")
(webhook-hook-run hook)))))
(webhook-configuration-hooks config))))
<>)))))
(define (webhook-shepherd-service config)
(shepherd-service
(documentation "Run webhook.")
(provision '(webhook))
(requirement '(networking))
(start
(let ((hooks-json (computed-file "hooks.json" (hooks-json-gexp config))))
#~(make-forkexec-constructor
(list #$(least-authority-wrapper
(file-append (webhook-configuration-package config)
"/bin/webhook")
#:name "webhook"
#:mappings (list (file-system-mapping
(source hooks-json)
(target source))
(file-system-mapping
(source (webhook-configuration-log-directory config))
(target source)
(writable? #t)))
;; TODO: If socket is a Unix socket, run in a
;; network namespace. We can't do this yet due to
;; https://yhetil.org/guix/m1ilknoi5r.fsf@fastmail.net/
#:namespaces (delq 'net %namespaces))
"-hooks" #$hooks-json
"-ip" #$(forge-ip-socket-ip (webhook-configuration-socket config))
"-port" #$(number->string (forge-ip-socket-port (webhook-configuration-socket config)))
"-logfile" #$(string-append (webhook-configuration-log-directory config)
"/webhook.log"))
#:user "webhook"
#:group "webhook"
#:log-file "/var/log/webhook.log")))
(stop #~(make-kill-destructor))))
(define webhook-service-type
(service-type
(name 'webhook)
(description "Run webhook.")
(extensions (list (service-extension account-service-type
(const %webhook-accounts))
(service-extension activation-service-type
webhook-activation)
(service-extension shepherd-root-service-type
(compose list webhook-shepherd-service))))
(compose concatenate)
(extend (lambda (config hook-extensions)
(webhook-configuration
(inherit config)
(hooks (append (webhook-configuration-hooks config)
hook-extensions)))))
(default-value (webhook-configuration))))
|
