blob: e34ae91175bf9b1d7cb6bab7a3c8300d90df91cd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
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)))
|
