Changeset 13457 in project


Ignore:
Timestamp:
03/02/09 23:51:43 (11 years ago)
Author:
Alaric Snell-Pym
Message:

V0.5 release

Location:
release/3/ugarit/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/3/ugarit/trunk/backend-fs.scm

    r13116 r13457  
    172172            (set-file-position! *log* 0 seek/end)
    173173           
    174             ; FIXME: At this point, insert a nice recoverable header that can be used to
    175             ; reconstruct the index if required by scanning the log
    176            
    177             (let ((posn (file-position *log*)))
     174           
     175            (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
     176                  (posn (file-position *log*)))
     177               (file-write *log* header)
    178178               (file-write *log* (u8vector->blob/shared data))
    179179               (gdbm-store *index* (make-index-key key)
    180                   (make-index-entry type posn (u8vector-length data)))
     180                  (make-index-entry type (+ (string-length header) posn) (u8vector-length data)))
    181181               (void)))
    182182
     
    200200            (signal (make-property-condition 'exn 'message "Log archives do not support deletion")))
    201201         (lambda (tag key) ; set-tag!
     202            (file-write *log* (sprintf "(tag ~S ~S)" tag key))
    202203            (gdbm-store *tags* (make-index-tag tag) key))
    203204         (lambda (tag) ; tag
     
    208209            (gdbm-fold *tags* (lambda (key value acc) (cons key acc)) '()))
    209210         (lambda (tag) ; remove-tag!
     211            (file-write *log* (sprintf "(untag ~S)" tag))
    210212            (gdbm-delete *tags* (make-index-tag tag)))
    211213         (lambda (tag) ; lock-tag!
     
    263265            (set-file-position! *log* 0 seek/end)
    264266           
    265             ; FIXME: At this point, insert a nice recoverable header that can be used to
    266             ; reconstruct the index if required by scanning the log
    267            
    268             (let ((posn (file-position *log*)))
     267            (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
     268                  (posn (file-position *log*)))
    269269               (if (> posn max-logpart-size)
    270270                  (begin
     
    276276                     (set! *log* (file-open (string-append logdir "/log" (number->string *logcount*))
    277277                                    (+ open/creat open/rdwr open/append) perm/irwxu))))
     278               (file-write *log* header)
    278279               (file-write *log* (u8vector->blob/shared data))
    279280               (gdbm-store *index* (make-index-key key)
    280                   (make-index-entry type *logcount* posn (u8vector-length data)))
     281                  (make-index-entry type *logcount* (+ (string-length header) posn) (u8vector-length data)))
    281282               (void)))
    282283
     
    302303            (signal (make-property-condition 'exn 'message "Log archives do not support deletion")))
    303304         (lambda (tag key) ; set-tag!
     305            (file-write *log* (sprintf "(tag ~S ~S)" tag key))
    304306            (gdbm-store *tags* (make-index-tag tag) key))
    305307         (lambda (tag) ; tag
     
    310312            (gdbm-fold *tags* (lambda (key value acc) (cons key acc)) '()))
    311313         (lambda (tag) ; remove-tag!
     314            (file-write *log* (sprintf "(untag ~S)" tag))
    312315            (gdbm-delete *tags* (make-index-tag tag)))
    313316         (lambda (tag) ; lock-tag!
  • release/3/ugarit/trunk/ugarit-core.scm

    r13224 r13457  
    55(use posix)
    66(use tiger-hash)
     7(use sha2)
    78(use aes)
    89(use crypto-tools)
    910(use z3)
    1011(use lzma)
     12(use stty)
    1113(include "posixextras.scm")
    1214(include "backend-fs.scm")
     
    1921   archive-writable?
    2022   archive-unlinkable?
     23   archive-exists?
    2124   archive-get
    2225   archive-put!
     
    117120      ((1) (blob->u8vector/shared (string->blob (z3:decode-buffer (blob->string (u8vector->blob/shared (subu8vector block 1 (u8vector-length block)))))))) ; deflate
    118121      ((2) (blob->u8vector/shared (lzma:decompress (u8vector->blob/shared (subu8vector block 1 (u8vector-length block)))))))) ; lzma
    119      
     122
     123(define (choose-hash-function config)
     124   (let ((make-basic-hash (lambda (hash) (lambda (block type) (string-append (hash block) (symbol->string type)))))
     125         (make-keyed-hash (lambda (hash key) (lambda (block type) (hash (string-append key (hash block) (symbol->string type)))))))
     126   (match config
     127      ((or #f ('tiger)) (make-basic-hash tiger192:digest))
     128      (('tiger key) (make-keyed-hash tiger192:digest key))
     129      (('sha256) (make-basic-hash sha256:digest))
     130      (('sha256 key) (make-keyed-hash sha256:digest key))
     131      (('sha384) (make-basic-hash sha384:digest))
     132      (('sha384 key) (make-keyed-hash sha384:digest key))
     133      (('sha512) (make-basic-hash sha512:digest))
     134      (('sha512 key) (make-keyed-hash sha512:digest key))
     135      (else (signal (make-property-condition 'exn 'message "Unknown hash algorithm" 'arguments config))))))
     136
     137(define (read-password prompt)
     138  (display prompt)
     139  (with-stty '(not echo) read-line))
     140
     141; Key specs are "hexhexhex" or (number-of-bytes "passphrase")
     142(define (key->blob keyspec)
     143   (cond
     144      ((string? keyspec)
     145         (hexstring->blob keyspec))
     146      ((pair? keyspec)
     147         (let* ((get-passphrase (lambda (maybe-passphrase)
     148                  (if (eq? maybe-passphrase 'prompt)
     149                     (read-password "Passphrase: ")
     150                     maybe-passphrase)))
     151                (length (car keyspec))
     152                (passphrase (get-passphrase (cadr keyspec)))
     153                (key (sha512:binary-digest passphrase)))
     154            (if (> length 64) ; 512 bits = 64 bytes
     155               (signal (make-property-condition 'exn 'message "Cannot generate a key that large due to a shortage of a big enough hash function (max 64)" 'arguments keyspec))
     156               (string->blob (substring/shared key 0 length)))))))
     157         
     158
    120159(define (choose-crypto-functions config)
    121160   (match config
     
    123162         (lambda (block) block)
    124163         (lambda (block) block))) ; No encryption
    125       (('aes keyhex)
    126          (let ((key (hexstring->blob keyhex))
     164      (('aes keyspec)
     165         (let ((key (key->blob keyspec))
    127166               (iv (make-blob 16)) ; IV is pseudo-randomly generated based on the blocks we are fed as an entropy source
    128167               (stir-iv! (lambda (iv block)
     
    147186                        (make-aes256-decryptor key)))
    148187                     (else
    149                         (signal (make-property-condition 'exn 'message "AES keys must be 16, 24, or 32 bytes long" 'arguments keyhex))))))
     188                        (signal (make-property-condition 'exn 'message "AES keys must be 16, 24, or 32 bytes long" 'arguments keyspec))))))
    150189                  (let ((cbc-encryptor (make-cbc*-encryptor encryptor 16))
    151190                        (cbc-decryptor (make-cbc*-decryptor decryptor 16)))
     
    169208         (*compression* #f)
    170209         (*crypto* #f)
     210         (*hash* #f)
    171211         (*double-check?* #f))
    172212   
     
    182222            (('storage 'debug 'fs path) (set! *storage*
    183223               (backend-debug (backend-fs path) "DEBUG")))
     224            (('hash . conf) (set! *hash* conf))
    184225            (('compression . conf) (set! *compression* conf))
    185226            (('encryption . conf) (set! *crypto* conf))
     
    192233      (let-values
    193234         (((compress) (choose-compression-function *compression*))
     235          ((hash) (choose-hash-function *hash*))
    194236          ((encrypt decrypt) (choose-crypto-functions *crypto*)))
    195237
     
    199241            store-atime?
    200242            store-ctime?
    201             ; FIXME: Don't just use hash+type as the key, hash the type in so keys are all the same length
    202             ; Also, incorporate some key data into the hash somehow, so that attackers can't just look in the
    203             ; archive for known block hashes
    204             (lambda (block type) (string-append (tiger192:digest block) (symbol->string type)))
     243            hash
    205244            compress
    206245            decompress
  • release/3/ugarit/trunk/ugarit.meta

    r13226 r13457  
    55 (license "BSD")
    66 (category data)
    7  (needs miscmacros gdbm tiger-hash z3 lzma srfi-37 aes crypto-tools)
     7 (needs miscmacros gdbm tiger-hash sha2 aes crypto-tools z3 lzma srfi-37 stty)
    88 (author "Alaric Snell-Pym")
    99 (synopsis "A backup/archival system based on content-addressed storage"))
  • release/3/ugarit/trunk/ugarit.scm

    r13224 r13457  
    251251   (("snapshot" confpath tag fspath)
    252252      (let ((archive (open-archive
    253          (with-input-from-file confpath read) *store-atime?* *store-ctime?*)))
     253         (with-input-from-file confpath read-file) *store-atime?* *store-ctime?*)))
    254254         
    255255         (printf "Archiving ~A to tag ~A...\n" fspath tag)
     
    267267   (("explore" confpath)
    268268      (let ((archive (open-archive
    269          (with-input-from-file confpath read) *store-atime?* *store-ctime?*)))
     269         (with-input-from-file confpath read-file) *store-atime?* *store-ctime?*)))
    270270
    271271         (let/cc quit
     
    275275   (("fork" confpath tag newtag)
    276276      (let ((archive (open-archive
    277          (with-input-from-file confpath read) *store-atime?* *store-ctime?*)))
     277         (with-input-from-file confpath read-file) *store-atime?* *store-ctime?*)))
    278278         
    279279         (archive-set-tag! archive newtag (archive-tag archive tag))
     
    281281         (archive-close! archive)))
    282282   
     283   (("cat" confpath key)
     284      (let ((archive (open-archive
     285         (with-input-from-file confpath read-file) *store-atime?* *store-ctime?*)))
     286         (let ((type (archive-exists? archive key))
     287               (block (archive-get archive key)))
     288               (printf "BLock with key ~A (type ~A) is ~A bytes:\n" key type (u8vector-length block))
     289               (write-u8vector block))
     290           
     291         (archive-close! archive)))
     292   
    283293   (_
    284294      (printf "Invalid command line. Try \"ugarit -h\" for help.\n") (exit)))
  • release/3/ugarit/trunk/ugarit.setup

    r13224 r13457  
    22(compile -c -O2 -d1 ugarit-core.scm -unit ugarit-core)
    33(install-extension 'ugarit-core '("ugarit-core.so" "ugarit-core.o")
    4   '((version 0.3)
     4  '((version 0.5)
    55    (static "ugarit-core.o")
    66    (documentation "ugarit.html")))
     
    88(compile ugarit.scm)
    99(install-program 'ugarit "ugarit"
    10   '((version 0.4)
     10  '((version 0.5)
    1111    (documentation "ugarit.html")))
Note: See TracChangeset for help on using the changeset viewer.