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
|
;; webid-oidc, implementation of the Solid specification
;; Copyright (C) 2020, 2021 Vivien Kraus
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;; This program 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 Affero General Public License for more details.
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(use-modules (webid-oidc http-link)
(webid-oidc testing)
(web http)
(web request)
(web response)
(web uri))
(with-test-environment
"http-link"
(lambda ()
(declare-link-header!)
;; Declare it twice to check that there’s no problem
(declare-link-header!)
(let ((example-zero "<>")
(example-one "<h>")
(example-two "<https://two.example.com>; ok")
(example-three "<https://three.example.com>; a=b")
(example-four "<https://four.example.com>; a=\"\\\\b\\n\"")
(example-five "<https://five.example.com>; ok; a=b; a=\"\\\\b\\n\"")
(expected-zero "Link: <>\r\n")
(expected-one "Link: <h>\r\n")
(expected-two "Link: <https://two.example.com>; ok\r\n")
(expected-three "Link: <https://three.example.com>; a=\"b\"\r\n")
(expected-four "Link: <https://four.example.com>; a=\"\\\\b\n\"\r\n")
(expected-five "Link: <https://five.example.com>; ok; a=\"b\"; a=\"\\\\b\n\"\r\n"))
(let ((example-six
(string-join (list
example-zero
example-one
example-two
example-three
example-four
example-five)
", "))
(expected-six
"Link: <>, <h>, <https://two.example.com>; ok, <https://three.example.com>; a=\"b\", <https://four.example.com>; a=\"\\\\b\n\", <https://five.example.com>; ok; a=\"b\"; a=\"\\\\b\n\"\r\n"))
(define (test str)
(let ((parsed (parse-header 'link str)))
(call-with-output-string
(lambda (port)
(write-header 'link parsed port)))))
(let ((zero (test example-zero))
(one (test example-one))
(two (test example-two))
(three (test example-three))
(four (test example-four))
(five (test example-five))
(six (test example-six)))
(unless (equal? zero expected-zero)
(exit 1))
(unless (equal? one expected-one)
(exit 2))
(unless (equal? two expected-two)
(exit 3))
(unless (equal? three expected-three)
;; This test is the first to fail if the Link header
;; handler is not installed.
(exit 4))
(unless (equal? four expected-four)
(exit 5))
(unless (equal? five expected-five)
(exit 6))
(unless (equal? six expected-six)
(exit 7)))))
(let ((first-link-uri (string->uri "https://example.com/vocab#link"))
(second-link-uri (string->uri "https://example.com/vocab#type")))
(let ((first-link
`(,first-link-uri (rel . "type")))
(second-link
`(,second-link-uri (rel . "type"))))
(let ((request (build-request
(string->uri "https://example.com")
#:headers
`((link . (,first-link))
(link . (,second-link))))))
(let ((response (build-response #:headers `((link . ,(request-links request))))))
(let ((links (response-links response)))
(unless (equal? links
(list
(list (string->uri "https://example.com/vocab#link") (cons 'rel "type"))
(list (string->uri "https://example.com/vocab#type") (cons 'rel "type"))))
(exit 8)))))))))
|