examples/folio.scm

1;;; Generic user Shepherd configuration helpers. Loading this file starts

2;;; nothing: register the returned services in your own configuration.

3(use-modules (shepherd service)

4 (shepherd service log-rotation)

5 (guix build utils)

6 (ice-9 binary-ports)

7 (ice-9 format)

8 (rnrs bytevectors))

10(define (prepare-folio-files! config state root token)

11 (mkdir-p config)

12 (mkdir-p state)

13 (mkdir-p root)

14 (unless (file-exists? token)

15 (let* ((bytes (call-with-input-file "/dev/urandom"

16 (lambda (input) (get-bytevector-n input 32))))

17 (_ (unless (= (bytevector-length bytes) 32)

18 (error "Could not read a complete random token")))

19 ;; Exclusive creation preserves a credential created elsewhere.

20 (output (fdopen (open-fdes token

21 (logior O_WRONLY O_CREAT O_EXCL)

22 #o600)

23 "w")))

24 (dynamic-wind

25 (lambda () #t)

26 (lambda ()

27 (for-each (lambda (byte) (format output "~2,'0x" byte))

28 (bytevector->u8-list bytes))

29 (newline output))

30 (lambda () (close-port output))))))

32(define (folio-services executable root)

33 (let* ((home (getenv "HOME"))

34 (config (string-append (or (getenv "XDG_CONFIG_HOME")

35 (string-append home "/.config"))

36 "/folio"))

37 (state (string-append (or (getenv "XDG_STATE_HOME")

38 (string-append home "/.local/state"))

39 "/folio"))

40 (token (string-append config "/http.token"))

41 (log (string-append state "/http.log")))

42 (list

43 (service '(folio-http)

44 #:respawn? #t

45 #:documentation "Authenticated local Folio MCP server."

46 #:start

47 (lambda args

48 (prepare-folio-files! config state root token)

49 (apply

50 (make-forkexec-constructor

51 (list executable "serve" "--http" "18765"

52 "--token-file" token "--log-level" "info")

53 #:environment-variables

54 (cons (string-append "FOLIO_ROOT=" root)

55 (default-environment-variables))

56 #:log-file log)

57 args))

58 #:stop (make-kill-destructor))

59 (log-rotation-service #:compression 'none

60 #:expiry (* 14 24 60 60)

61 #:rotation-size-threshold (* 1024 1024)))))