98 lines
3.5 KiB
Racket
98 lines
3.5 KiB
Racket
#!/usr/bin/env racket
|
|
#lang racket/base
|
|
|
|
(require racket/file racket/format racket/match racket/string racket/system
|
|
ffi/unsafe)
|
|
(provide (struct-out user) (struct-out post)
|
|
list-users get-posts dfs-modtime sorted-level
|
|
hash-ref*
|
|
*post-index*)
|
|
|
|
(define *pub-path*
|
|
(let ([hostname (file->string "/etc/hostname")])
|
|
(if (string=? (string-trim hostname) "lgbt")
|
|
(build-path "/pub")
|
|
(let ([uid ((get-ffi-obj "getuid" (ffi-lib "libc" '("6" "7")) (_fun -> _int)))])
|
|
(displayln "using remote mount")
|
|
(system "gio mount sftp://unix.lgbt/pub")
|
|
(build-path "/run/user/" (~a uid) "gvfs/sftp:host=unix.lgbt/pub")))))
|
|
|
|
;; pseudo-node name to represent the index post at a tree level
|
|
;; starts with a slash because you can't put those in filenames :3
|
|
(define *post-index* "/index")
|
|
|
|
;; data definitions
|
|
(struct user [name description path] #:transparent)
|
|
(struct post [forum path timestamp author content] #:transparent)
|
|
|
|
;; gets a hash of username to user struct
|
|
(define (list-users)
|
|
(define users (directory-list *pub-path*))
|
|
(for/hash ([u (in-list users)])
|
|
(define un (path->string u))
|
|
(displayln un)
|
|
(define base (build-path *pub-path* u "forum"))
|
|
(define desc-path (build-path base "description.txt"))
|
|
(define desc (if (file-exists? desc-path)
|
|
(file->string desc-path)
|
|
"<unknown description>"))
|
|
(values un (user un desc base))))
|
|
|
|
;; given the (list-users) hash, fetches and organizes every post into a rose tree, with leaf nodes
|
|
;; being tagged with *post-index* representing a list of posts at that level (multiple users could
|
|
;; make the same title of post)
|
|
(define (get-posts users)
|
|
(define (valid-txt? path)
|
|
(and (not (equal? path (build-path "description.txt")))
|
|
(file-exists? path)
|
|
(regexp-match? #rx"\\.txt$" path)))
|
|
|
|
(define posts (make-hash))
|
|
|
|
(define (insert-tree! fullpath p [ctx posts])
|
|
(match fullpath
|
|
['()
|
|
(hash-update! ctx *post-index* (lambda (r) (cons p r)) '())]
|
|
[(list fst rst ...)
|
|
(insert-tree! rst p (hash-ref! ctx fst make-hash))]))
|
|
|
|
(for ([(un u) (in-hash users)] #:when (directory-exists? (user-path u)))
|
|
(displayln un)
|
|
(define base (user-path u))
|
|
(parameterize ([current-directory base])
|
|
(for ([item (in-directory)] #:when (valid-txt? item))
|
|
(displayln item)
|
|
(define timestamp (file-or-directory-modify-seconds item))
|
|
(define parts (map path->string (explode-path (path-replace-extension item #""))))
|
|
;; we require that posts are at least 2 levels deep (forum name, post title)
|
|
(match parts
|
|
[(list forum post-path ...)
|
|
(define p (post forum post-path timestamp un (file->string item)))
|
|
(insert-tree! parts p)]
|
|
[_ (displayln "invalid path")]))))
|
|
posts)
|
|
|
|
(define (dfs-modtime start [path '()] [modtimes (make-hash)])
|
|
(define newest
|
|
(for/fold ([newest 0]) ([(k v) (in-hash start)])
|
|
(cond
|
|
[(equal? k *post-index*)
|
|
(apply max newest (map post-timestamp v))]
|
|
[else
|
|
(max newest (dfs-modtime v (cons k path) modtimes))])))
|
|
(hash-set! modtimes (reverse path) newest)
|
|
newest)
|
|
|
|
(define (hash-ref* h k)
|
|
(match k
|
|
['() h]
|
|
[(cons f r) (hash-ref* (hash-ref h f) r)]))
|
|
|
|
(define (sorted-level posts modtimes path)
|
|
(define level-posts
|
|
(for/list ([(k v) (in-hash (hash-ref* posts path))])
|
|
(cons k v)))
|
|
(map cdr
|
|
(sort level-posts >
|
|
#:key (λ (p) (hash-ref modtimes (append path (list (car p))))))))
|