Changeset 25477 in project for release/4/ugarit/trunk


Ignore:
Timestamp:
11/06/11 10:07:42 (10 years ago)
Author:
Alaric Snell-Pym
Message:

ugarit: Unit test suite now covers everything except fold-archive-node over directories (but that's really hard to test, and really simple to implement, so not worth testing, right?)

Location:
release/4/ugarit/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/ugarit/trunk/README.txt

    r20325 r25477  
    266266## Backends
    267267
    268 * Support for remote backends. This will involve splitting the
    269   backends into separate executables, and having the frontend talk to
    270   them via a simple protocol over standard input and output. Then it
    271   will be possible to use ssh to talk to backends on remote machines,
    272   as well as various other interesting integration opportunities.
     268* Eradicate all GPL taint from gdbm by using sqlite for storing
     269  metadata in backends!
     270
     271* Remove backend-log. Have just backend-fs, backend-splitlog, and
     272  maybe a backend-sqlite for everything-in-sqlite storage (plus future
     273  S3/SFTP backends). Not including meta-backends such as backend-cache
     274  and backend-replicated.
     275
     276* Support for recreating the index and tags on a backend-log or
     277  backend-splitlog if they get corrupted, from the headers left in the
     278  log. Do this by extending the backend protocol with a special
     279  "admin" command that allows for arbitrary backend-specific
     280  operations, and write an ugarit-backend-admin CLI tool to administer
     281  backends with it.
     282
     283* Support for unlinking in backend-splitlog, by marking byte ranges as
     284  unused in the metadata (and by touching the headers in the log so we
     285  maintain the invariant that the metadata is a reconstructible cache)
     286  and removing the entries for the unlinked blocks, perhaps provide an
     287  option to attempt to re-use existing holes to put blocks in for
     288  online reuse, and provide an offline compaction operation.
    273289
    274290* Support for SFTP as a storage backend. Store one file per block, as
     
    278294  talk that simple binary protocol. Tada!
    279295
    280 * Support for S3 as a storage backend. What's the best way to get at
    281   the S3 API? Write our own client, or find a C library to wrap?
    282 
    283 * Support for recreating the index and tags on a backend-log or
    284   backend-splitlog if they get corrupted, from the headers left in the
    285   log.
     296* Support for S3 as a storage backend. There is now an S3 egg!
    286297
    287298* Support for replicated archives. This will involve a special storage
     
    300311  recreated in usage, as otherwise the system may assume blocks are
    301312  present when they are not, and thus fail to upload them when
    302   snapshotting.
     313  snapshotting. The individual physical archives that we put
     314  replication on top of won't be "valid" archives unless they are 100%
     315  replicated, as they'll contain references to blocks that are on
     316  other archives. It might be a good idea to mark them as such with a
     317  special tag to avoid people trying to restore directly from them. A
     318  copy of the replication configuration could be stored under a
     319  special tag to mark this fact, and to enable easy finding of the
     320  proper replicated archive to work from.
    303321
    304322## Core
     323
     324* Eradicate all GPL taint from gdbm by using sqlite for storing
     325  the mtime cache!
    305326
    306327* Better error handling. Right now we give up if we can't read a file
     
    379400  referencing the old one as a parent.
    380401
     402* Dump/restore format. On a dump, walk an arbitrary subtree of an
     403  archive, serialising objects. Do not put any hashes in the dump
     404  format - dump out entire files, and just identify objects with
     405  sequential numbers when forming the directory / snapshot trees. On a
     406  restore, read the same format and slide it into an archive (creating
     407  any required top-level snapshot objects if the dump doesn't start
     408  from a snapshot) and putting it onto a specified tag. The
     409  intension is that this format can be used to migrate your stuff
     410  between archives, perhaps to change to a better backend.
     411
    381412## Front-end
    382413
    383414* Better error messages
    384 
    385 * Archive transfer: a command to open two archives. From the source
    386   one, it lists all tags, then for each tag, walks the history, and
    387   for each snapshot, copies it to the destination archive. For
    388   migrating archives to a new backend.
    389415
    390416* FUSE support. Mount it as a read-only filesystem :-D Then consider
     
    392418  copy-on-write of blocks to a buffer area on the local disk, then the
    393419  option to make a snapshot of `current`.
    394 
    395 * More explicit support for archival usage: really, a different kind
    396   of tag. Rather than having a chain of snapshots of the same
    397   filesystem, the tag would have some kind of database of snapshots,
    398   with more emphasis on metadata and searchability.
    399420
    400421* Filesystem watching. Even with the hash-caching trick, a snapshot
     
    492513# Version history
    493514
     515* 0.8: decoupling backends from the core and into separate binaries,
     516  accessed via standard input and output, so they can be run over SSH
     517  tunnels and other such magic.
     518
    494519* 0.7: file cache support, sorting of directories so they're archived
    495520  in canonical order, autoloading of hash/encryption/compression
  • release/4/ugarit/trunk/backend-fs.scm

    r21301 r25477  
    33(use srfi-69)
    44(use matchable)
     5(use regex)
    56
    67(define (backend-fs base)
    7    (define (make-name key extension) ; FIXME: break into levels to reduce files-in-one-dir strain
     8   (define (make-name key extension) ; Break into levels to reduce files-in-one-dir strain
    89      (cond
    910         ((< (string-length key) 4)
     
    148149         (void))))
    149150
    150 (define (backend-log logfile indexfile tagsfile)
     151#;(define (backend-log logfile indexfile tagsfile)
    151152   (let ((*index* (gdbm-open indexfile))
    152153         (*tags* (gdbm-open tagsfile))
     
    339340          (backend-fs base))
    340341
    341          (("log" logfile indexfile tagsfile)
     342         #;(("log" logfile indexfile tagsfile)
    342343          (backend-log logfile indexfile tagsfile))
    343344
  • release/4/ugarit/trunk/test/run.scm

    r22628 r25477  
    44(use test)
    55(use posix)
     6(use posix-extras)
    67(use directory-rules)
     8(use matchable)
    79(include "../backend-devtools.scm")
    810(include "../backend-cache.scm")
     
    8284   (test-assert "Archive is in initial state" (null? (directory store-path))))
    8385
     86(define (check-extract-results path plain-file1-contents plain-file2-contents)
     87  (let* ((tp (lambda (relative) (string-append path "/" relative)))
     88         (check-file (lambda (relative contents)
     89                       (when contents
     90                             (test (sprintf "Contents of ~s are as expected" relative)
     91                                   contents
     92                                   (with-input-from-file (tp relative) read))))))
     93
     94    ;; Plain file(s)
     95    (check-file "plain-file1" plain-file1-contents)
     96    (check-file "plain-file2" plain-file2-contents)
     97
     98    ;; FIFO
     99    (test-assert "FIFO exists" (fifo? (tp "fifo")))
     100
     101    ;; Specials
     102    (if (zero? (current-user-id))
     103        (begin
     104          (let* ((stats (file-stat (tp "block-special")))
     105                 (type (bitwise-and (vector-ref stats 1) stat/ifmt))
     106                 (devnum (vector-ref stats 10)))
     107            (test-assert "Block special file exists" (eq? type stat/ifblk))
     108            (test "Block special file has correct devnum" 123 devnum))
     109
     110          (let* ((stats (file-stat (tp "character-special")))
     111                 (type (bitwise-and (vector-ref stats 1) stat/ifmt))
     112                 (devnum (vector-ref stats 10)))
     113            (test-assert "Character special file exists" (eq? type stat/ifchr))
     114            (tets "Character special file has correct devnum" 456 devnum))))
     115
     116    ;; Directory
     117    (test-assert "Directory exists" (directory? (tp "directory")))))
     118
    84119(define (test-archive a store-path)
    85120   (if (archive-unlinkable? a)
     
    322357   (test-group "Directories"
    323358               (let* ((test-dir (string-append store-path "-test-data"))
    324                       (extract-dir (string-append store-path "-test-extract"))
     359                      (extract1-dir (string-append store-path "-test-extract1"))
     360                      (extract2-dir (string-append store-path "-test-extract2"))
     361                      (extract3-dir (string-append store-path "-test-extract3"))
     362                      (extract4-dir (string-append store-path "-test-extract4"))
    325363                      (tp (lambda (relative)
    326364                            (string-append test-dir "/" relative))))
    327365                 (create-directory test-dir)
    328                  (with-output-to-file (tp "plain-file") (lambda () (write "Hello world")))
     366                 (with-output-to-file (tp "plain-file1") (lambda () (write "Hello world")))
    329367                 (create-fifo (tp "fifo"))
    330                  #;(create-special-file (tp "block-special") stat/ifblk 123)
    331                  #;(create-special-file (tp "character-special") stat/ifchr 456)
     368                 ;; These two need root!
     369                 (if (zero? (current-user-id))
     370                     (begin
     371                       (create-special-file (tp "block-special") stat/ifblk 123)
     372                       (create-special-file (tp "character-special") stat/ifchr 456)))
    332373                 (create-directory (tp "directory"))
    333374
    334                  (test-define-values "Store a directory" (dir-key dir-reused?)
     375                 ;; Dump it
     376                 (test-define-values "Store a directory" (dir1-key dir1-reused?)
    335377                                     (call-with-context-support
    336378                                      (archive-global-directory-rules a)
     
    338380                                       (store-directory! a test-dir))))
    339381
    340                  (create-directory extract-dir)
     382                 (create-directory extract1-dir)
    341383
    342384                 (test "Extract a directory" (void)
    343                        (extract-directory! a dir-key extract-dir))
    344 
    345                  ;; FIXME: Compare the contents of test-dir and extract-dir?
    346 
     385                       (extract-directory! a dir1-key extract1-dir))
     386
     387                 (check-extract-results extract1-dir "Hello world" #f)
     388
     389                 ;; Now add an extra file and dump again
     390                 (with-output-to-file (tp "plain-file2") (lambda () (write "Hello world 2")))
     391
     392                 (test-define-values "Store a directory again" (dir2-key dir2-reused?)
     393                                     (call-with-context-support
     394                                      (archive-global-directory-rules a)
     395                                      (lambda ()
     396                                       (store-directory! a test-dir))))
     397
     398                 (test-assert "Changed directory is not reused" (not dir2-reused?))
     399
     400                 (create-directory extract2-dir)
     401                 (test "Extract a directory" (void)
     402                       (extract-directory! a dir2-key extract2-dir))
     403
     404                 (check-extract-results extract2-dir "Hello world" "Hello world 2")
     405
     406                 ;; Now change an existing file and dump again
     407                 (with-output-to-file (tp "plain-file1") (lambda () (write "Hello world again!")))
     408
     409                 (test-define-values "Store a directory again" (dir3-key dir3-reused?)
     410                                     (call-with-context-support
     411                                      (archive-global-directory-rules a)
     412                                      (lambda ()
     413                                       (store-directory! a test-dir))))
     414
     415                 (test-assert "Changed directory is not reused" (not dir3-reused?))
     416
     417                 (create-directory extract3-dir)
     418                 (test "Extract a directory" (void)
     419                       (extract-directory! a dir3-key extract3-dir))
     420
     421                 (check-extract-results extract3-dir "Hello world again!" "Hello world 2")
     422
     423                 ;; Now make no changes and dump again
     424                 (test-define-values "Store a directory again" (dir4-key dir4-reused?)
     425                                     (call-with-context-support
     426                                      (archive-global-directory-rules a)
     427                                      (lambda ()
     428                                       (store-directory! a test-dir))))
     429
     430                 (test-assert "Unchanged directory is reused" dir4-reused?)
     431                 (test "Mark reused directory" (void) (archive-link! a dir4-key))
     432                 (create-directory extract4-dir)
     433                 (test "Extract a directory" (void)
     434                       (extract-directory! a dir4-key extract4-dir))
     435                 (check-extract-results extract4-dir "Hello world again!" "Hello world 2")
     436
     437                 ;; Tidy up
    347438                 (if (archive-unlinkable? a)
    348439                     (begin
    349                        (test "Delete the directory" (void) (unlink-directory! a dir-key))
     440                       (test "Delete the first directory" (void) (unlink-directory! a dir1-key))
     441                       (check-extract-results extract2-dir "Hello world" "Hello world 2")
     442                       (test "Delete the second directory" (void) (unlink-directory! a dir2-key))
     443                       (check-extract-results extract3-dir "Hello world again!" "Hello world 2")
     444                       (test "Delete the third directory" (void) (unlink-directory! a dir3-key))
     445                       (check-extract-results extract4-dir "Hello world again!" "Hello world 2")
     446                       (test "Delete the fourth directory" (void) (unlink-directory! a dir4-key))
    350447                       (check-dir-is-empty store-path)))))
    351 #|
    352    
    353    (printf "snapshots\n")
    354 
    355    (printf "\tStore a directory\n")
    356    
    357    (define-values (dir-key dir-reused?)
    358       (store-directory! archive "test-data"))
    359 
    360    (if (archive-unlinkable? a)
    361       (assert (not dir-reused?)))
    362 
    363    (printf "\tTag it (~A ~A)\n" dir-key dir-reused?)
    364    (define sk1 (tag-snapshot! archive "Test" dir-key dir-reused? (list)))
    365    
    366    (printf "\tStore another directory\n")
    367 
    368    (define-values (dir-key-two dir-reused?)
    369       (store-directory! archive "test-data"))
    370    
    371    (assert dir-reused?)
    372    (assert (string=? dir-key dir-key-two))
    373    
    374    (printf "\tTag it (~A ~A)\n" dir-key  dir-reused?)
    375    (define sk1 (tag-snapshot! archive "Test" dir-key-two dir-reused? (list)))
    376    
    377    (printf "\tWalk the history\n")
    378    
    379    (define result
    380       (fold-history archive (archive-tag archive "Test")
    381          (lambda (snapshot-key snapshot acc)
    382             (cons snapshot acc))
    383          '()))
    384    (assert (match result
    385      (((('previous . sk1)
    386         ('mtime . _)
    387         ('contents . dir-key-two))
    388        (('mtime . _)
    389         ('contents . dir-key))) #t)
    390      (else #f)))
    391    
    392    ;(printf "\tTest fold-archive-node\n")
    393    ;
    394    ;(printf "Root: \n") (pp (fold-archive-node archive '() (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
    395    ;(printf "Tag 'Test': \n") (pp (fold-archive-node archive (cons 'tag "Test") (lambda (name dirent acc) (cons (cons name dirent) acc))  '()))
    396    ;(printf "Root directory: \n") (pp (fold-archive-node archive dir-key (lambda (name dirent acc) (cons (cons name dirent) acc))  '()))
    397    
    398 |#
     448
     449   (test-group "Snapshots"
     450               (let* ((test-dir (string-append store-path "-test-data")))
     451                 (test-define-values "Store a directory" (dir-key dir-reused?)
     452                                     (call-with-context-support
     453                                      (archive-global-directory-rules a)
     454                                      (lambda ()
     455                                        (store-directory! a test-dir))))
     456
     457                 (if (archive-unlinkable? a)
     458                     (test-assert "Directory was not reused" (not dir-reused?)))
     459
     460                 (test-define-values "Tag it as a snapshot" (sk1)
     461                                     (tag-snapshot! a "Test" dir-key dir-reused? (list)))
     462
     463                 (test-define-values "Store the directory again" (dir2-key dir2-reused?)
     464                                     (call-with-context-support
     465                                      (archive-global-directory-rules a)
     466                                      (lambda ()
     467                                        (store-directory! a test-dir))))
     468
     469                 (test-assert "Directory was reused" dir2-reused?)
     470
     471                 (test-assert "Directory has the same key" (string=? dir-key dir2-key))
     472
     473                 (test-define-values "Tag it as a snapshot" (sk2)
     474                                     (tag-snapshot! a "Test" dir2-key dir2-reused? (list)))
     475
     476                 (test-define-values "Walk the history with fold-history" (result)
     477                                     (fold-history a (archive-tag a "Test")
     478                                                   (lambda (snapshot-key snapshot acc)
     479                                                     (cons snapshot acc))
     480                                                   '()))
     481                 (test-assert "History has expected form"
     482                              (match result
     483                                     (((('previous . sk1*)
     484                                        ('mtime . _)
     485                                        ('contents . dir2-key*))
     486                                       (('mtime . _)
     487                                        ('contents . dir-key*)))
     488                                      (and (string=? sk1 sk1*)
     489                                           (string=? dir2-key dir2-key*)
     490                                           (string=? dir-key dir-key*)))
     491                                     (else #f)))
     492
     493                 (test-define-values "Walk the tag list with fold-archive-node" (root)
     494                                     (fold-archive-node a '() (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
     495                 (test-assert "Root history has expected form"
     496                              (match root
     497                                     (((('tag . "Test")
     498                                        "Test"
     499                                        'tag
     500                                        ('current . sk2*)))
     501                                      (string=? sk2 sk2*))
     502                                     (else #f)))
     503                 (test-define-values "Walk the history of tag 'Test' with fold-archive-node" (tag)
     504                                     (fold-archive-node a '(tag . "Test") (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
     505                 (test-assert "Tag history has expected form"
     506                              (match tag
     507                                     (((dir-key-c*
     508                                        "current"
     509                                        'snapshot
     510                                        ('previous . sk1*)
     511                                        ('mtime . _)
     512                                        ('contents . dir-key*))
     513                                       (dir-key-c**
     514                                        _
     515                                        'snapshot
     516                                        ('previous . sk1**)
     517                                        ('mtime . _)
     518                                        ('contents . dir-key**))
     519                                       (dir-key-c***
     520                                        _
     521                                        'snapshot
     522                                        ('mtime . _)
     523                                        ('contents . dir-key***)))
     524                                      (and
     525                                       (string=? sk1 sk1*)
     526                                       (string=? dir-key dir-key-c*)
     527                                       (string=? dir-key dir-key*)
     528                                       (string=? sk1 sk1**)
     529                                       (string=? dir-key dir-key-c**)
     530                                       (string=? dir-key dir-key**)
     531                                       (string=? dir-key dir-key-c***)
     532                                       (string=? dir-key dir-key***)))
     533                                     (else #f)))
     534                 (test-define-values "Walk the root directory with fold-archive-node" (dir)
     535                                     (fold-archive-node a dir-key (lambda (name dirent acc) (cons (cons name dirent) acc)) '()))
     536                 ; FIXME: Write a giant match to match this bad boy...
     537                 (pp dir)
     538                 (printf "sk1: ~a\n" sk1)
     539                 (printf "sk2: ~a\n" sk2)
     540                 (printf "dir-key: ~a\n" dir-key)
     541                 (printf "dir2-key: ~a\n" dir2-key)
     542
     543
     544))
    399545
    400546   "This archive seems to work!")
    401547
    402 
    403548;; Actual Tests
    404549
     550(if (directory? "./tmp")
     551    (delete-directory "./tmp" #t))
    405552(create-directory "./tmp")
    406553
     
    449596 (test "Close archive" (void) (archive-close! be)))
    450597
     598(printf "Final count of failures: ~a\n" (test-failure-count))
     599
    451600(test-exit)
  • release/4/ugarit/trunk/ugarit-core.scm

    r22448 r25477  
    1717         archive-unlock-tag!
    1818         archive-tag-locked?
     19         archive-link!
    1920         archive-unlink!
    2021         archive-close!
     
    4344         store-file!
    4445         write-file-contents
     46         unlink-file!
     47         
    4548         store-directory!
    4649         unlink-directory!
     
    5760(use autoload)
    5861
    59 (autoload lzma (compress lzma:compress) (decompress lzma:decompress))
    60 (autoload z3 z3:encode-buffer z3:decode-buffer)
     62(define ((deny-autoload module)) (error (sprintf "Autoload does not seem to be working, so optional components from module ~s are not working" module) module))
     63
     64(define-syntax no-autoload
     65  (er-macro-transformer
     66   (lambda (expr rename compare)
     67     (let ((module (cadr expr))
     68           (procs (cddr expr))
     69           (_begin (rename 'begin))
     70           (_define (rename 'define))
     71           (_deny-autoload (rename 'deny-autoload)))
     72           (cons _begin
     73                 (map (lambda (x)
     74                        (let ((orig-binding (if (pair? x) (car x) x))
     75                              (new-binding (if (pair? x) (cadr x) x)))
     76                          `(,_define ,new-binding (,_deny-autoload ',module))))
     77                      procs))))))
     78
     79(no-autoload lzma (compress lzma:compress) (decompress lzma:decompress))
     80(no-autoload z3 z3:encode-buffer z3:decode-buffer)
    6181(autoload tiger-hash tiger192-digest tiger192-binary-digest)
    62 (autoload sha2 sha256-digest sha384-digest sha512-digest sha512-binary-digest)
    63 (autoload aes make-aes128-encryptor make-aes128-decryptor make-aes192-encryptor make-aes192-decryptor make-aes256-encryptor make-aes256-decryptor)
     82(no-autoload sha2 sha256-digest sha384-digest sha512-digest sha512-binary-digest)
     83(no-autoload aes make-aes128-encryptor make-aes128-decryptor make-aes192-encryptor make-aes192-decryptor make-aes256-encryptor make-aes256-decryptor)
    6484
    6585(use srfi-1)
     
    176196                                        ; Generate initial IV from the key and current time
    177197            (move-memory! (string->blob (tiger192-binary-digest
    178                                          (string-append (blob->string key) (number->string (time->seconds (current-time)))))) iv 16)
     198                                         (string-append (blob->string key) (number->string (current-seconds))))) iv 16)
    179199
    180200            (let-values (((encryptor decryptor)
     
    716736      (unlink-sexpr-stream-block! archive key sexpr-unlink!))
    717737     (else
    718       (assert (or (eq? type leaf-type) (eq? type ks-type)))))))
     738      (assert (or (eq? type leaf-type) (eq? type ks-type)) (sprintf "unlink-sexpr-stream!: Invalid block type (expected ~a)" (list leaf-type ks-type)) type)))))
    719739
    720740;; DIRECTORY STORAGE
     
    859879    (if (or mtime atime)
    860880        (change-file-times path
    861                            (if atime (cdr atime) (time->seconds (current-time)))
    862                            (if mtime (cdr mtime) (time->seconds (current-time)))))
     881                           (if atime (cdr atime) (current-seconds))
     882                           (if mtime (cdr mtime) (current-seconds))))
    863883
    864884    (void)))
     
    9941014         (append
    9951015          (list
    996            (cons 'mtime (time->seconds (current-time)))
     1016           (cons 'mtime (current-seconds))
    9971017           (cons 'contents contents-key))
    9981018          snapshot-properties))
Note: See TracChangeset for help on using the changeset viewer.