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
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
(define-module (webid-oidc program)
#:use-module (webid-oidc errors)
#:use-module (webid-oidc reverse-proxy)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc config) #:prefix cfg:)
#:use-module (ice-9 optargs)
#:use-module (ice-9 receive)
#:use-module (ice-9 i18n)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 suspendable-ports)
#:use-module (srfi srfi-19)
#:use-module (rnrs bytevectors)
#:use-module (web uri)
#:use-module (web request)
#:use-module (web response)
#:use-module (web client)
#:use-module (webid-oidc cache)
#:use-module (web server))
(define (G_ text)
(let ((out (gettext text)))
(if (string=? out text)
;; No translation, disambiguate
(car (reverse (string-split text #\|)))
out)))
(define* (http-get-with-log uri #:key (headers '()))
(define date (date->string (time-utc->date (current-time))))
(define uri-string (if (uri? uri) (uri->string uri) uri))
(format (current-error-port) "~a: GET ~a ~s...\n"
date uri-string headers)
(receive (response response-body) (http-get uri #:headers headers)
(format (current-error-port) "~a: GET ~a ~s: ~s ~a bytes\n"
date uri-string headers response
(if (bytevector? response-body)
(bytevector-length response-body)
(string-length response-body)))
(values response response-body)))
(define cache-http-get
(with-cache #:http-get http-get-with-log))
(define-public (main)
(setvbuf (current-output-port) 'none)
(setvbuf (current-error-port) 'none)
(setlocale LC_ALL "")
(bindtextdomain cfg:package cfg:localedir)
(textdomain cfg:package)
(let ((version-sym
(string->symbol (G_ "command-line|version")))
(help-sym
(string->symbol (G_ "command-line|help")))
(port-sym
(string->symbol (G_ "command-line|server|port")))
(server-name-sym
(string->symbol (G_ "command-line|server|server-name")))
(backend-uri-sym
(string->symbol (G_ "command-line|server|reverse-proxy|backend-uri")))
(header-sym
(string->symbol (G_ "command-line|server|reverse-proxy|header")))
(log-file-sym
(string->symbol (G_ "comand-line|log-file")))
(error-file-sym
(string->symbol (G_ "comand-line|error-file"))))
(let ((options
(let ((spec
`((,version-sym (single-char #\v) (value #f))
(,help-sym (single-char #\h) (value #f))
(,log-file-sym (single-char #\l) (value #t))
(,error-file-sym (single-char #\e) (value #t))
(,port-sym (single-char #\p) (value #t))
(,server-name-sym (single-char #\n) (value #t))
(,header-sym (single-char #\H) (value #t))
(,backend-uri-sym (single-char #\b) (value #t)))))
(getopt-long (command-line) spec))))
(cond
((option-ref options help-sym #f)
(format #t (G_ "Usage: ~a COMMAND [OPTIONS]...
Run the webid-oidc COMMAND.
Available commands:
~a:
run an authenticating reverse proxy.
General options:
-h, --~a:
display a short help message and exit.
-v, --~a:
display the version information (~a) and exit.
-l FILE.log, --~a=FILE.log:
redirect the program standard output to FILE.log.
-e FILE.err, --~a=FILE.err:
redirect the program errors to FILE.err.
General server-side options:
-p PORT, --~a=PORT:
set the server port to bind, 8080 by default.
-n URI, --~a=URI:
set the public server URI (scheme, userinfo, host, and port).
Options for the reverse proxy:
-H HEADER, --~a=HEADER:
the HEADER field contains the webid of the authenticated user,
XXX-Agent by default.
-b URI, --~a=URI:
set the backend URI for the reverse proxy, only for the
reverse-proxy command.
Environment variables:
LANG: set the locale of the user interface (for the server commands,
the user is the system administrator).~a
Running a reverse proxy
Suppose that you operate data.provider.com. You want to run an
authenticating reverse proxy, that will receive incoming requests
through http://localhost:8080, and forward them to
https://private.data.provider.com. The backend will look for the
XXX-Agent header, and if it is found, then its value will be
considered the webid of the authenticated
user. https://private.data.provider.com should only accept requests
from this reverse proxy.
~a ~a \\
--~a 8080 \\
--~a 'https://data.provider.com' \\
--~a 'https://private.data.provider.com' \\
--~a 'XXX-Agent' \\
--~a '/var/log/proxy.log' \\
--~a '/var/log/proxy.err'
If you find a bug, then please send a report to ~a.
")
;; Usage:
(car (command-line))
;; Available commands:
(G_ "command-line|command|reverse-proxy")
;; General options
;; help
help-sym
;; version
version-sym
cfg:version
;; log-file
log-file-sym
;; error-file
error-file-sym
;; General server-side options
;; port
port-sym
;; server-name
server-name-sym
;; Options for the reverse proxy
;; header
header-sym
;; backend-uri
backend-uri-sym
;; Environment variables
;; LANG
(if (getenv "LANG")
(format #f (G_ "an environment variable| It is currently set to ~s.")
(getenv "LANG"))
(G_ "an environment variable| It is currently unset."))
;; Running a reverse proxy
;; Program name
(car (command-line))
;; command
(G_ "command-line|command|reverse-proxy")
;; options
port-sym server-name-sym backend-uri-sym header-sym
log-file-sym error-file-sym
;; Bug report
cfg:package-bugreport))
((option-ref options version-sym #f)
(format #t (G_ "~a version ~a\n")
cfg:package cfg:version))
(else
(let ((rest (option-ref options '() '()))
(port
(let ((port (string->number (option-ref options port-sym "8080"))))
(unless port
(format (current-error-port)
(G_ "The --~a argument must be a number, not ~s.\n")
port-sym
(option-ref options port-sym "8080"))
(exit 1))
(unless (integer? port)
(format (current-error-port)
(G_ "The --~a argument must be an integer, not ~s.\n")
port-sym
port)
(exit 1))
(unless (> port 0)
(format (current-error-port)
(G_ "The --~a argument must be positive, ~s is invalid.\n")
port-sym port)
(exit 1))
(unless (<= port 65535)
(format (current-error-port)
(G_ "The --~a argument must be less than 65536, ~s is invalid.\n")
port-sym port)
(exit 1))
port))
(server-name
(let ((str (option-ref options server-name-sym #f)))
(and str
(string->uri str))))
(backend-uri
(let ((str (option-ref options backend-uri-sym #f)))
(and str
(string->uri str))))
(header
(let ((str (option-ref options header-sym #f)))
(and str
(string->symbol str)))))
(when (null? rest)
(format (current-error-port)
(G_ "Usage: ~a COMMAND [OPTIONS]...\nSee --~a (-h).\n")
(car (command-line))
help-sym)
(exit 1))
(install-suspendable-ports!)
(when (option-ref options log-file-sym #f)
(set-current-output-port
(stubs:open-output-file* (option-ref options log-file-sym #f)))
(setvbuf (current-output-port) 'none))
(when (option-ref options error-file-sym #f)
(set-current-error-port
(stubs:open-output-file* (option-ref options error-file-sym #f)))
(setvbuf (current-error-port) 'none))
(let ((command (car rest))
(non-options (cdr rest)))
(cond
((equal? command (G_ "command-line|command|reverse-proxy"))
(begin
(unless server-name
(format (current-error-port) (G_ "You must pass --~a to set the server name.\n")
server-name-sym)
(exit 1))
(unless backend-uri
(format (current-error-port) (G_ "You must pass --~a to set the backend URI.\n")
backend-uri-sym)
(exit 1))
(run-server
(make-reverse-proxy
#:server-uri server-name
#:http-get cache-http-get
#:endpoint backend-uri
#:auth-header header)
'http
(list #:port port))))
(else
(format (current-error-port) (G_ "Unknown command ~s\n")
command)
(exit 1))))))))))
|
