Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
L
lsh
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Deploy
Releases
Model registry
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
GitLab community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
LSH
lsh
Commits
2a60310a
Commit
2a60310a
authored
26 years ago
by
Niels Möller
Browse files
Options
Downloads
Patches
Plain Diff
*** empty log message ***
Rev: src/lsh_keygen.c:1.3 Rev: src/make_char_classes:1.1
parent
7ff9d349
No related branches found
No related tags found
No related merge requests found
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
src/lsh_keygen.c
+1
-1
1 addition, 1 deletion
src/lsh_keygen.c
src/make_char_classes
+283
-0
283 additions, 0 deletions
src/make_char_classes
with
284 additions
and
1 deletion
src/lsh_keygen.c
+
1
−
1
View file @
2a60310a
/* lsh_keygen.c
/* lsh_keygen.c
*
*
* Generic key-generation program. Writes a spki-package
s
private key
* Generic key-generation program. Writes a spki-package
d
private key
* on stdout. You would usually pipe this to some other program to
* on stdout. You would usually pipe this to some other program to
* extract the public key, encrypt the private key, and save the
* extract the public key, encrypt the private key, and save the
* results in two separate files.
* results in two separate files.
...
...
This diff is collapsed.
Click to expand it.
src/make_char_classes
0 → 100755
+
283
−
0
View file @
2a60310a
#! /usr/local/bin/scsh \
-e main -s
!#
;; Reads an alist of character classes and their contents,
;; computes a partition of disjunct sets, associate a bit with each
;; partition set, and finally writes a C file containing
;; a partition table index by character, and masks corresponding to
;; the input classes.
(define (my-error s . args)
(error (apply format #f s args)))
(define (debug s . args)
; (apply format (error-output-port) s args))
#f)
(define (werror s . args)
(apply format (error-output-port) s args))
(define (filter p l)
(cond ((null? l) l)
((p (car l))
(cons (car l) (filter p (cdr l))))
(else (filter p (cdr l)))))
(define (reduce op start l)
(if (null? l)
start
(reduce op (op start (car l)) (cdr l))))
(define (subvector v start end)
(let ((n (make-vector (- end start))))
(let loop ((i start))
(when (< i end)
(vector-set! n (- i start) (vector-ref v i))
(loop (+ i 1))))
n))
(define (vector-split v n)
(let ((parts (make-vector n))
(length (quotient (+ (vector-length v) n -1) n)))
(let loop ((i 0) (start 0))
(cond ((= i (- n 1))
(vector-set! parts i (subvector v start (vector-length v))))
(else
(vector-set! parts i (subvector v start (+ start length)))
(loop (+ i 1) (+ start length)))))
parts))
(define (implode separator list)
(cond ((null? list) "")
((null? (cdr list)) (car list))
(else
(string-append (car list) separator (implode separator (cdr list))))))
;;
(define (input->char-set o)
(define (->ascii x)
(if (integer? x) x
(char->ascii x)))
(cond ((string? o)
(string->char-set o))
((list? o)
(reduce char-set-union (chars->char-set
(map ascii->char (filter integer? o)))
(map (lambda (pair)
(ascii-range->char-set (->ascii (car pair))
(+ 1 (->ascii (cdr pair)))))
(filter pair? o))))
(else (my-error "Bad char set specification ~s" o))))
;; Depends on charsets implemented as strings
(define char-set=? string=?)
(define char-set-empty?
(let ((empty (chars->char-set '())))
(lambda (o) (char-set=? o empty))))
(define char-set-assoc assoc)
;; We use an acyclic graph, where the input char-sets are used as
;; roots, and two intersecting nodes will branch into three childen,
;; one of which is shared. The children of each node are disjunct.
;;
;; ABC BCD
;; / \ / \
;; A BC D
(define (make-tree set)
;; Fields are set, leafness, left and right child (if any) and indexnumber.
(vector set #t #f #f #f))
(define (tree/set tree)
(vector-ref tree 0))
(define (tree/leaf? tree)
(vector-ref tree 1))
(define (tree/left tree)
(vector-ref tree 2))
(define (tree/right tree)
(vector-ref tree 3))
(define (tree/split! tree left right)
(cond ((tree/leaf? tree)
(vector-set! tree 1 #f)
(vector-set! tree 2 left)
(vector-set! tree 3 right))
(else (my-error "Attempt to split non-leaf"))))
(define (tree/index tree)
(vector-ref tree 4))
(define (tree/index! tree n)
(vector-set! tree 4 n))
(define (tree-describe tree)
(if (tree/leaf? tree)
(list 'leaf
(tree/index tree)
(char-set-members (tree/set tree)))
(list 'node
(char-set-members (tree/set tree))
(tree-describe (tree/left tree))
(tree-describe (tree/right tree)) )))
(define (make-tree-cache initial)
(let ((cache (map (lambda (tree) (cons (tree/set tree) tree))
initial)))
(lambda (set)
(debug "cache: ~s\n" (map (lambda (pair) (char-set-members (car pair)))
cache))
(cond ((char-set-assoc set cache)
=> cdr)
(else
(let ((new (make-tree set)))
(debug "Adding set ~s\n" (char-set-members set))
(set! cache (cons (cons set new) cache))
new))))))
(define (for-children f tree)
(f (tree/left tree))
(f (tree/right tree)))
;; Iterate over all leafs
(define (for-leafs f tree)
(if (tree/leaf? tree)
(f tree)
(for-children (lambda (c) (for-leafs f c)) tree)))
(define (map-leafs f tree)
(if (tree/leaf? tree)
(list (f tree))
(append (map-leafs f (tree/left tree))
(map-leafs f (tree/right tree)))))
;; Destructivly intersect the leafs of two trees
(define (tree-intersect! cache t1 t2)
(if (eq? t1 t2)
t1
(let* ((s1 (tree/set t1))
(s2 (tree/set t2))
(intersection (char-set-intersection s1 s2)))
(if (not (char-set-empty? intersection))
(if (tree/leaf? t1)
(if (tree/leaf? t2)
(let ((diff1 (char-set-difference s1 s2))
(diff2 (char-set-difference s2 s1)))
(define (split-subset! super sub diff)
(tree/split! super sub (cache diff)))
(if (char-set-empty? diff1)
(if (char-set-empty? diff2)
(my-error "Two copies of ~s ~s"
(tree-describe t1)
(tree-describe t2))
; t1 is a subset of t2, so we need only split t2
(split-subset! t2 t1 diff2))
(if (char-set-empty? diff2)
; t2 is a subset of t1, so split t1
(split-subset! t1 t2 diff1)
; Both differences ar non-empty, so split both
(let ((common (cache intersection)))
(tree/split! t1 common (cache diff1))
(tree/split! t2 common (cache diff2))))))
; t1 is a leaf, but not t2. Recurse.
(for-children (lambda (c)
(tree-intersect! cache t1 c))
t2))
; t1 is a non-leaf
(for-children (lambda (c)
(tree-intersect! cache t2 c))
t1))))))
(define-syntax when
(syntax-rules () ((when test . consequences) (if test (begin . consequences)))))
(define (partition! sets)
(let ((cache (make-tree-cache sets)))
(let loop ((left sets))
(let ((head (car left))
(tail (cdr left)))
(when (not (null? tail))
(for-each (lambda (tree) (tree-intersect! cache head tree))
tail)
(loop tail))))))
(define (index-leafs! roots)
(let ((index 1)
(leafs '()))
(for-each (lambda (tree)
(for-leafs (lambda (leaf)
(when (not (tree/index leaf))
(tree/index! leaf index)
(set! index (+ 1 index))
(set! leafs (cons leaf leafs))))
tree))
roots)
leafs))
(define (build-char-table leafs)
(let ((table (make-vector #x100 0)))
(for-each (lambda (leaf)
(let ((flag (tree/index leaf)))
(for-each (lambda (c)
(vector-set! table (char->ascii c) flag))
(char-set-members (tree/set leaf)))))
leafs)
table))
(define (build-mask root)
(map-leafs tree/index root))
(define (prepare-input l)
(map (lambda (pair)
(cons (car pair) (make-tree (input->char-set (cdr pair)))))
l))
(define test-input
'((alpha . ( (#\a . #\z) (#\A . #\Z) ))
(digits . ( (#\0 . #\9)))
(base64 . ( (#\a . #\z) (#\A . #\Z) (#\0 . #\9) #\+ #\/ #\=))
(hex . ( (#\0 . #\9) (#\a . #\f) (#\A . #\F) ))))
(define (test1)
(let* ((input (prepare-input test-input))
(roots (map cdr input)))
(partition! roots)
(let ((leafs (index-leafs! roots)))
(werror "~s disjunct classes found." (length leafs))
(build-char-table leafs))))
#!
(map (lambda (pair)
(cons (car pair) (tree-describe (cdr pair))))
input)))
!#
(define (bit->mask bit)
(format #f "1L<<~s" bit))
(define (make-char-classes input)
(let* ((classes (prepare-input input))
(roots (map cdr classes)))
(partition! roots)
(let ((leafs (index-leafs! roots)))
(werror "~s disjunct classes found.\n" (length leafs))
(format #t "int char_classes[] = {\n ~a\n};\n\n"
(implode ",\n "
(map (lambda (row)
(implode ", " (map bit->mask
(vector->list row))))
(vector->list (vector-split (build-char-table leafs)
32))))))
(for-each (lambda (class)
(format #t "#define CHAR_~a (~a)\n"
(car class)
(implode " | " (map bit->mask (build-mask (cdr class))))))
classes)
(format #t "#define CHAR_other 1\n")))
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment