The `org' directory is no longer necessary

1 files changed, 133 insertions, 0 deletions

diff --git a/jakob/dynamic/util.scm b/jakob/dynamic/util.scm
new file mode 100644
index 0000000..e34ae91
--- /dev/null
+++ b/jakob/dynamic/util.scm
@@ -0,0 +1,133 @@
+;;; Copyright © 2019 - 2023 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob dynamic util)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (web request)
+  #:use-module (web uri)
+  #:export (assoc-value
+            acons-normalize
+            base64-length
+            decode-form
+            date<?
+            hash-append!
+            emoji?
+            from-tor?
+            from-i2p?
+            from-darknet?))
+
+(define (assoc-value alist key)
+  "Return the `car' of `(assoc alist key)' if truthy"
+  (let ((result (assoc-ref alist key)))
+    (if result (car result) result)))
+
+(define (acons-list k v alist)
+  "Add V to K to alist as list"
+  (let ((value (assoc-ref alist k)))
+    (if value
+        (let ((alist (alist-delete k alist)))
+          (acons k (cons v value) alist))
+        (acons k (list v) alist))))
+
+(define (acons-normalize key value alist)
+  "Add KEY -> VALUE to ALIST such that no entries for KEY are duplicates"
+  (cons (cons key value)
+        (filter (lambda (pair) (not (equal? (car pair) key))) alist)))
+
+(define (list->alist lst)
+  "Build a alist of list based on a list of key and values.
+
+   Multiple values can be associated with the same key"
+  (let next ((lst lst)
+             (out '()))
+    (if (null? lst)
+        out
+        (next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
+
+(define (decode-form bv)
+  "Convert BV querystring or form data to an alist"
+  (define string (if (string? bv) bv (utf8->string bv)))
+  (define pairs (map (cut string-split <> #\=)
+                     ;; semi-colon and amp can be used as pair separator
+                     (append-map (cut string-split <> #\;)
+                                 (string-split string #\&))))
+  (list->alist (map (match-lambda
+                      ((key value)
+                       (cons (uri-decode key) (uri-decode value)))) pairs)))
+
+(define (base64-length n)
+  "The length of the base64 string encoding `n' bytes."
+  (inexact->exact (* 4 (ceiling (/ n 3.0)))))
+
+(define (date<? d1 d2)
+  "Return #t if D2 specifies a later date than D1"
+  (time<? (date->time-utc d1) (date->time-utc d2)))
+
+(define (hash-append! table key item)
+  "Append ITEM to the list specified by KEY in TABLE
+
+If KEY does not exist in TABLE, initialize kEY to (list ITEM)"
+  (if (hash-ref table key)
+      (hash-set! table key (cons item (hash-ref table key)))
+      (hash-set! table key (list item))))
+
+(define (emoji? str)
+  "Determine if `str' is an 'acceptable' emoji character
+
+Acceptable is the following subset:
+
+- The 'Emoticons' block
+- The 'Supplemental Symbols and Pictographs' block, excluding U+1F900
+  through U+1F90B
+- The hand symbols from the 'Miscellaneous Symbols and Pictographs'
+  block
+- The hand symbols from the 'Dingbats' block
+- U+1F37B and U+1F440
+
+Notably, U+1F946 isn't normally treated an emoji, but it is here. I
+think it should be! As an American, I should be able to use pictographs
+to express my God-given constitutional rights!"
+  (and (string? str)
+       (= 1 (string-length str))
+       (let ((codepoint (char->integer
+                         (first (string->list str)))))
+         (or (<= #x1F600 codepoint #x1F64F)
+             (<= #x1F90C codepoint #x1F9FF)
+             (<= #x1F446 codepoint #x1F450)
+             (<= #x270A codepoint #x270D)
+             (= codepoint #x1F37B)
+             (= codepoint #x1F440)))))
+
+(define (from-tor? request)
+  "Return whether or not REQUEST was sent by the Tor daemon"
+  (let ((originating-ip (assoc-ref (request-headers request) 'x-forwarded-for)))
+    (or (string=? "127.0.0.1" originating-ip)
+        (string=? "::1" originating-ip))))
+
+(define (from-i2p? request)
+  "Return whether or not REQUEST was sent by i2pd"
+  (let ((originating-ip (assoc-ref (request-headers request) 'x-forwarded-for)))
+    (and (or (string-prefix? "127." originating-ip)
+             (string-suffix? ":1" originating-ip))
+         (not (from-tor? request)))))
+
+(define (from-darknet? request)
+  "Return whether or not REQUEST was sent by a darknet tunnel"
+  (or (from-tor? request) (from-i2p? request)))