source: project/release/3/stream-ldif/stream-ldif.scm @ 9687

Last change on this file since 9687 was 588, checked in by azul, 15 years ago

Fixing CRLF termination. Dang, was broken.

File size: 3.6 KB
Line 
1;; $Id: stream-ldif.scm 1582 2005-03-14 02:54:14Z azul $
2;;
3;; This file is in the public domain and may be reproduced or copied without
4;; permission from its author.  Citation of the source is appreciated.
5;;
6;; Alejandro Forero Cuervo <bachue@bachue.com>
7;;
8;; This file implements an egg for Chicken Scheme that can parse or produce
9;; files in the LDAP Data Interchange Format (LDIF) file format.
10;;
11;; Documentation is available in HTML format.
12;;
13;; Newer versions might be available at:
14;;
15;;    http://anonymous:@afc.no-ip.info:8000/svn/home/src/chicken-eggs/stream-ldif
16;;
17;; 1.0 - (r1582) First public release
18;;
19;; Note that you can dump an entire LDAP database using ldapsearch with the -L
20;; option.
21
22(declare (export stream->ldif ldif->stream))
23(require-extension stream-ext srfi-40 srfi-1 stream-base64)
24
25; Append lines that start with space to their previous lines and
26; remove them.  The space is removed as well.
27
28(define (join-lines lines)
29  (stream-delay
30    (cond
31      ((or (stream-null? lines) (stream-null? (stream-cdr lines))) lines)
32      ((or (stream-null? (stream-cadr lines))
33           (not (char-whitespace? (stream-caadr lines))))
34       (stream-cons (stream-car lines) (join-lines (stream-cdr lines))))
35      (else
36        (join-lines
37          (stream-cons (stream-append (stream-car lines) (stream-cdadr lines))
38                       (stream-cddr lines)))))))
39
40; Remove all comments from the LDIF file.  Here comments are lines that
41; *start* with #\#.
42
43(define (remove-comments lines)
44  (stream-filter
45    (lambda (x) (or (stream-null? x) (not (char=? (stream-car x) #\#))))
46    lines))
47
48(define (lines->change lines)
49  (let ((hash (make-hash-table)))
50    (stream-for-each
51      (lambda (line)
52        (receive (name value) (stream-break (lambda (x) (char=? x #\:)) line)
53          (parse-line hash (stream->symbol (stream-map char-downcase name)) (stream-cadr value) (stream-drop-while char-whitespace? (stream-cddr value)))))
54      lines)
55    hash))
56
57; Given a file (stream of chars) with an LDIF file, return a stream with one
58; hash table for each change.  The keys of the hash tables are attribute names
59; (as symbols).
60
61; It is important to do join-lines before remove-comments: some comments span
62; multiple lines and the continuations start with space.
63
64(define stream->ldif
65  (compose
66    (lambda (entries) (stream-map lines->change entries))
67    (lambda (entries) (stream-filter (complement stream-null?) entries))
68    (lambda (lines) (stream-split lines stream-null?))
69    remove-comments
70    join-lines
71    stream-lines))
72
73; Return a text representation of the value for an attribute in the
74; LDIF file.
75
76(define (parse-line change name type value)
77  (hash-table-set! change name
78    (cons
79      (case type
80        ((#\space #\<) value)
81        ((#\:) (base64-decode value))
82        (else (error "Unknown type: " type)))
83      (hash-table-ref/default change name '()))))
84
85; Return a stream with one change from an LDIF file.
86
87(define (change->lines change)
88  (stream-append
89    (ldif-line (stream #\d #\n) (car (hash-table-ref change 'dn)))
90    (stream-concatenate (list->stream (change-attrs change)))
91    (stream #\newline)))
92
93(define (change-attrs change)
94  (map
95    (lambda (data)
96      (stream-concatenate
97        (list->stream
98          (map (cut ldif-line (symbol->stream (car data)) <>) (cdr data)))))
99    (filter (lambda (c) (not (eq? (car c) 'dn)))
100            (hash-table->alist change))))
101
102(define (ldif-line name value)
103  (stream-append name (stream #\: #\space) value (stream #\newline)))
104
105(define (ldif->stream changes)
106  (stream-concatenate (stream-map change->lines changes)))
107
Note: See TracBrowser for help on using the repository browser.