Last active
March 5, 2023 17:04
-
-
Save tkurtbond/63bbbc1738da300d8ebb0ff6bd2bf2c5 to your computer and use it in GitHub Desktop.
Download the list of gemini atom feeds from gemini://gemini.circumlunar.space/capcom/submitted-feeds.txt and then download all the feeds.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(module get-gemini-atom () | |
(import (scheme)) | |
(import (chicken base)) | |
(import (chicken file)) | |
(import (chicken process-context)) | |
(import (chicken condition)) | |
(import (utf8)) | |
(import args) | |
(import (gemini)) | |
(import (gemini client)) | |
(import (srfi 152)) | |
(import (loop)) | |
(import (schemepunk show)) | |
(import (uri-common)) | |
(import (clojurian syntax)) | |
(import (miscmacros)) | |
(import (simple-timer)) | |
(import (forcible)) | |
(import (exn-condition)) | |
(define (get-gemini-content response) | |
(if (gemini-response-success? response) | |
(gemini-response-read-string-all response) | |
#f)) | |
(define (format-query q) | |
(string-join | |
(loop for part in q | |
collect (string-append (symbol->string (car part)) "=" | |
(cdr part))) | |
";")) | |
(define (sanitize-url url) | |
(let* ((uri (uri-reference url)) | |
(scheme (and-> (uri-scheme uri) (symbol->string) (uri-encode-string))) | |
(host (and-> (uri-host uri) (uri-encode-string))) | |
(port (and-> (uri-port uri))) | |
(path (and-> (uri-path uri) (cdr) (string-join "-"))) | |
(query (and-> (uri-query uri) (format-query) (uri-encode-string)))) | |
(show #f scheme "-" host "-" (if (and (number? port) (not (= port 80))) | |
(each port "-") | |
nothing) | |
path (if (string=? "" query) nothing (each "-" query))))) | |
(define feeds-url "gemini://gemini.circumlunar.space/capcom/submitted-feeds.txt") | |
(define feeds-string (gemini-get feeds-url get-gemini-content)) | |
(define feeds (and feeds-string (string-split feeds-string "\n"))) | |
(define (save-feed url) | |
(show #t "Working on feed " url nl) (flush-output) | |
;; If you try to save the response and then call | |
;; gemini-response-read-string-all outside the context of the handler | |
;; it fails with the error | |
;; Error: (read-u8vector) port already closed: #<input port "(ssl)"> | |
;; which makes sense if you realize gemini-get has to clean up after | |
;; everything, so you have to do everything in the hander. | |
(define (response-handler response) | |
(cond ((gemini-response-success? response) | |
(let ((filename (sanitize-url url)) | |
(content (gemini-response-read-string-all response))) | |
(with-output-to-file filename (lambda () (display content))))) | |
(else | |
(show #t " Getting " url " unsuccessful: " | |
(gemini-response-code response) ": " | |
(gemini-response-meta response) nl)))) | |
(condition-case (force (future/timeout 10 (gemini-get url response-handler))) | |
[ex (exn) ; any exn exception bound to variable ex | |
(show #t " error: ex: " ex nl | |
" msg: " (written (exn-message ex)) nl | |
" args: " (written (exn-arguments ex)) nl)] | |
[ex () ; any non-exn exception | |
(cond | |
((timeout-condition? ex) | |
(show #t " timed out!" nl)) | |
(else | |
(show #t " had an unexpected error!" nl | |
" ex:" ex nl)))])) | |
(define *output-directory* #f) | |
(define +command-line-options+ | |
(list (args:make-option | |
(d directory) #:required "Output directory" | |
(set! *output-directory* arg)) | |
(args:make-option | |
(a add-url) #:required "Add a URL" | |
(push! arg feeds)) | |
)) | |
(define (main) | |
(receive (options operands) (args:parse (command-line-arguments) | |
+command-line-options+) | |
(when *output-directory* | |
(cond ((directory-exists? *output-directory*) | |
(change-directory *output-directory*)) | |
(else | |
(create-directory *output-directory*) | |
(change-directory *output-directory*)))) | |
(loop for feed in feeds do (save-feed feed)))) | |
;; Only invoke main if this has been compiled. That way we can load the | |
;; module into csi and debug it. | |
(cond-expand | |
(compiling | |
(main)) | |
(else)) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment