Commit 82595bf2 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Add working scheme port.

parent 013ca3a1
(import (chicken process signal)
(chicken process-context)
(chicken process-context posix)
(chicken string)
(chicken bitwise)
(srfi 1)
(srfi 69) ; hash tables
fuse
ssax
sxpath
sxpath-lolevel ; for sxml:text
http-client
uri-common)
(define-syntax let*
(syntax-rules ()
;; Base case
[(_ () body ...)
(begin body ...)]
;; "Regular" case
[(_ ((k value) rest ...) body ...)
(let ((k value))
(let* (rest ...)
body ...))]
;; SRFI-71 let-values
[(_ ((k k* ... values) rest ...) body ...)
(call-with-values (lambda () values)
(lambda (k k* ...)
(let* (rest ...)
body ...)))]
;; Declare variable without a value (actuall #f).
;; Useful for inner mutation.
[(_ (v rest ...) body ...)
(let* ((v #f) rest ...) body ...)]
))
(set! (form-urlencoded-separator) "&;")
(define base-uri
(make-uri
scheme: 'https
host: "datorhandbok.lysator.liu.se"
path: '(/ "api.php")
query: '((action . "query")
(export . #t)
(exportnowrap . #t))))
(define (uri-for-page page)
(update-uri base-uri
query: (cons `(titles . ,page)
(uri-query base-uri))))
(define (get-xml-page url)
(call-with-input-request
url #f
(lambda (port) (ssax:xml->sxml port '((mw . "http://www.mediawiki.org/xml/export-0.10/"))))))
(define (get-page ht pagename)
(unless (hash-table-exists? ht pagename)
(let* ((sxml request response (get-xml-page (uri-for-page pagename))))
(when ((if-sxpath '(// mw:page)) sxml)
(set! (hash-table-ref ht pagename) sxml))))
(hash-table-ref/default ht pagename #f))
(define ht (make-hash-table))
(define mediawiki-fs
(make-filesystem
init: (lambda () (print "Filesystem ready"))
readdir: (lambda (path)
(and (string=? path "/")
(cons* "." ".." (map ->string (hash-table-keys ht)))))
getattr: (lambda (path)
(cond
((string=? path "/")
(vector (bitwise-ior file/dir #o555)
2
(current-user-id)
(current-group-id)
(hash-table-size ht)
0 0 0))
(else
(let* ((page-path (car (string-split path "/")))
(page (get-page ht page-path)))
(if page
(let* ((id-str (sxml:text ((sxpath '(// mw:page mw:id)) page)))
(length-str (sxml:text ((sxpath '(// mw:page // mw:text @ bytes)) page)))
(id (read (open-input-string id-str)))
(length (read (open-input-string length-str))))
(vector (bitwise-ior file/reg #o444)
1
(current-user-id)
id length
0 0 0))
#f)))))
open: (lambda (path mode)
(cond ((string=? path "/") #f)
(else (let ((pagename (car (string-split path "/"))))
(get-page ht pagename)))))
read: (lambda (handle size offset)
(sxml:text
((sxpath '(// mw:page // mw:text)) handle)))
))
#;
(filesystem-start! "mnt" mediawiki-fs)
(define path (car (command-line-arguments)))
(when (filesystem-start! path mediawiki-fs)
(print "Starting filesystem")
(set-signal-handler!
signal/int
(lambda _ (filesystem-stop! path mediawiki-fs)))
(filesystem-wait! path mediawiki-fs)
(print "Filesystem shut down"))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment