Script
#!/usr/bin/env gsi-script
;; STYLE INFORMATION
(define css-files (list "../css/base.css" "../css/report.css"))
(define logo-link "https://tilde.green/")
(define logo-icon "../images/tildeverse.png")
(define logo-name "~Green")
;; ~GREEN INFORMATION
(define host "https://tilde.green/")
(define name "~Green")
(define members-file "~/public_html/data/green-members.ss") ; ("m1" "m2" …)
(define homepage-updates-file "~/public_html/data/green-homepage-updates.ss") ; ((('TIMESTAMP . t) ('USER . t) ('HOMEPAGE . t) ('FILE . t)))
(define members (with-input-from-file members-file (lambda () (read))))
(define homepage-updates (with-input-from-file homepage-updates-file (lambda () (read))))
;; STANDARD PROCEDURES
(define (take a-list n)
(let loop ((head '())
(tail a-list)
(k n))
(if (or (null? tail) (= k 0))
(reverse head)
(loop (cons (car tail) head) (cdr tail) (- k 1)))))
(define (last a-list)
(cond
((null? a-list) #f)
((null? (cdr a-list)) (car a-list))
(else (last (cdr a-list)))))
(define (filter a-list a-predicate)
(let loop ((valid-elements '())
(elements a-list))
(if (null? elements)
(reverse valid-elements)
(if (a-predicate (car elements))
(loop (cons (car elements) valid-elements)
(cdr elements))
(loop valid-elements (cdr elements))))))
(define (sort a-list an-order)
(if (null? a-list)
a-list
(let ((first (car a-list))
(rest (cdr a-list)))
(append
(sort (filter rest (lambda (x) (an-order x first))) an-order)
(list first)
(sort (filter rest (lambda (x) (not (an-order x first)))) an-order)))))
(define (string-index where what)
(letrec ((helper (lambda (index)
(if (> (+ index (string-length what)) (string-length where))
#f
(if (string=? (substring where index (+ index (string-length what))) what)
index
(helper (+ index 1)))))))
(helper 0)))
(define (string-replace where what with)
(let ((ind (string-index where what)))
(if ind
(string-append
(substring where 0 ind)
with
(string-replace (substring where (+ ind (string-length what)) (string-length where)) what with))
where)))
(define (string-html a-string)
(let replace ((s a-string)
(l (list (cons "&" "&") (cons "\"" """) (cons "<" "<") (cons ">" ">"))))
(if (null? l)
s
(replace (string-replace s (caar l) (cdar l)) (cdr l)))))
(define (html-link-css path-to-file)
(display (string-append "<link rel=\"preload\" href=\"" path-to-file "\" as=\"style\">\n"
"<link rel=\"stylesheet\" href=\"" path-to-file "\" type=\"text/css\">\n")))
(define (string-split what with)
(let process ((splits '())
(str what))
(let ((ind (string-index str with)))
(if ind
(process (cons (substring str 0 ind) splits) (substring str (+ ind (string-length with)) (string-length str)))
(reverse (cons str splits))))))
(define (format-date date)
(cdr (shell-command (string-append "echo -n " date " | cut -c1-19 | sed 's/./ @ /11' | tr -d '\n'") #t)))
;;HTML
;;(display "HTTP/1.0 200 OK\n\n") ;; WHEN USED AS CGI SCRIPT
(display "<!DOCTYPE html>\n")
(display "<html lang=\"en\">\n")
(display "<head>\n")
(display "<meta charset=\"UTF-8\">\n")
(display (string-append "<title>" name " REPORT</title>\n"))
(for-each (lambda (css) (html-link-css css)) css-files)
(display "<style>\n")
(display ".grid-4c{display:grid;grid-row-gap:0;grid-column-gap:0px;grid-template-columns: repeat(4, 1fr)}\n")
(display ".grid-4c a:hover{font-weight:600;width:100%}\n")
(display "</style>\n")
(display "</head>\n")
(display "<body>\n")
(display (string-append "<h1><a href=\"" host "\">" name "</a> Report</h1>\n"))
;; LATEST
(display "<h2>Latest</h2>\n")
(display "<table>\n")
(display "<tr><th>When</th><th>Who</th><th>What</th></tr>")
(for-each
(lambda (x)
(let ((t (format-date (cdr (assoc 'TIMESTAMP x))))
(m (cdr (assoc 'USER x)))
(h (cdr (assoc 'HOMEPAGE x)))
(f (cdr (assoc 'FILE x))))
(display
(string-append
"<tr>"
"<td>" t "</td>" "<td>" (string-append "<a href=\"" h"\">" m "</a>") "</td>" "<td>" (string-append "<a href=\"" f "\">" (last (string-split f "/")) "</a>") "</td>"
"</tr>\n"))))
homepage-updates)
(display "</table>\n")
;; MEMBERS
(display (string-append "<h2>Members : " (number->string (length members)) "</h2>\n"))
(display "<div class=\"grid-4c\">\n")
(for-each (lambda (m) (display (string-append "<a href=\"" host "~" m "\">" m "</a>\n"))) members)
(display "</div>\n")
;; UPTIME
(display (string-append "<h2>Uptime : " (cadr (string-split (cdr (shell-command "uptime -p" #t)) "up ")) "</h2>"))
;; TIMESTAMP
(display (string-append "<h2>Updated : " (cdr (shell-command "date +\"%Y-%m-%d @ %H:%M\"" #t)) "</h2>\n"))
;; SCRIPT SOURCE CODE
(display "<details>\n")
(display "<summary>Script</summary>")
(display "<pre>\n")
(let ((script (cdr (shell-command (string-append "cat" " " (car (command-line))) #t))))
(display (string-html script)))
(display "</pre>\n")
(display "</details>\n")
(display "<footer>\n")
(display (string-append "<a href=\"" logo-link "\"><img src=\"" logo-icon "\" alt=\"" logo-name "\" title=\"" logo-name "\"></a>\n"))
(display "</footer>\n")
(display "</body>\n")
(display "</html>\n")