From 951421c8bb745cfdad6a45e8f6f0866f162cea68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 16 Oct 2022 22:27:59 +0200 Subject: Handle liu-get script if gnutls is unavailable. --- scripts/fetch-liu-map-index.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/scripts/fetch-liu-map-index.scm b/scripts/fetch-liu-map-index.scm index a9518c8d..2ac300e1 100755 --- a/scripts/fetch-liu-map-index.scm +++ b/scripts/fetch-liu-map-index.scm @@ -23,6 +23,31 @@ ((hnh util) :select (-> ->>)) (json)) +;; Fallback to ensure we have HTTPS +(define http-get + (catch 'gnutls-not-available + (lambda () + ((@@ (web client) ensure-gnutls)) + (@ (web client) http-get)) + (lambda _ + (use-modules (ice-9 popen) + (web http)) + + (lambda (url . _) + (let ((pipe (open-pipe* OPEN_READ "curl" "--include" "--http1.1" url))) + (let ((intro (string-split (read-line pipe) #\space)) ; HTTP/1.1 200 OK\r + (headers (read-headers pipe))) + (let ((response + (build-response + version: (parse-http-version (list-ref intro 0)) + code: (string->number (list-ref intro 1)) + reason-phrase: (string-trim-right + (string-join (drop intro 2) " " 'infix) + char-whitespace?) + headers: headers + port: pipe + validate-headers?: #t))) + (values response pipe)))))))) ;; Parse string as HTML, find all links which are "map links", ;; and return them as an association list from name to url-fragments. -- cgit v1.2.3