summaryrefslogtreecommitdiff
path: root/ldp/etag.scm
blob: 756766e07a1f39e5ce2bfdaeb96b9ec2e737a0f7 (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
(define-module (ldp etag))

(define alphabet
  (string-join
   '("abcdefghijklmnopqrstuvwxyz"
     "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
     "0123456789"
     "-_")
   ""))

(define (generate-etag-letter)
  (string-ref alphabet (random (string-length alphabet))))

(define (generate-etag-letters n)
  (if (<= n 0)
      '()
      (cons (generate-etag-letter)
	    (generate-etag-letters (- n 1)))))

(define-public (generate-etag)
  (list->string (generate-etag-letters 16)))

(define-public (etag? x)
  (define (aux i)
    (or (>= i (string-length x))
	(and (let ((c (string-ref x i)))
	       (or (and (char>=? c #\a) (char<=? c #\z))
		   (and (char>=? c #\A) (char<=? c #\Z))
		   (and (char>=? c #\0) (char<=? c #\9))
		   (char=? c #\-)
		   (char=? c #\_)))
	     (aux (+ i 1)))))
  (and (string? x)
       (aux 0)))

(define-public (the-etag x)
  (unless (etag? x)
    (scm-error 'wrong-type-arg
	       "the-etag"
	       "Expected a string satisfying etag? from (ldp etag)."
	       '()
	       (list x)))
  x)