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


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

ugarit: Seemingly removed all the gdbm taint. Must remember to update the .meta to replace gdbm with sql-de-lite, though!

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

Legend:

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

    r25477 r25478  
    8282
    8383For most platforms, a max-logfile-size of 900000000 (900 MB) should suffice. For now, don't go much bigger than that on 32-bit systems until Chicken's `file-position` function is fixed to work with files >1GB in size.
    84 
    85 ### Old Logfile backend
    86 
    87 The old logfile backend works much like the original Venti system. It's append-only - you won't be able to delete old snapshots from a logfile archive, even when I implement deletion. It stores the archive in three files; one is a log of data blocks, one is a GDBM index that remembers where in the log each block resides, one is a GDBM of tags.
    88 
    89 This worked well, but exposed a bug in Chicken when dealing with files more than about a gigabyte on 32-bit platforms. I fixed that in short order, but it reminded me that some platforms don't like files larger than 2GB anyway, so I wrote a new logfile backend that splits the log file into chunks at a specified point. You probably want to use the new backend - the old backend is kept for compatability only.
    90 
    91 To set up an old logfile archive, just choose where to put the three files. It would be nice to put the index and tags on a different physical disk to the log, to reduce seeking.
    92 
    93 You can then refer to it using the following archive identifier:
    94 
    95       log "...logfile..." "...indexfile..." "...tagsfile..."
    96 
    97 Neither of the files need to exist in advance; Ugarit will create them.
    9884
    9985## Writing a ugarit.conf
  • release/4/ugarit/trunk/backend-cache.scm

    r21301 r25478  
    1 (use gdbm)
     1(use sql-de-lite)
     2
     3(define cache-sql-schema
     4  (list
     5   "CREATE TABLE cache (key TEXT PRIMARY KEY, type TEST);"))
    26
    37(define (backend-cache be cachepath)
    4    (define *key-cache* (gdbm-open cachepath))
     8   (define *db* (open-database cachepath))
     9   (when (null? (schema *db*))
     10         (for-each (lambda (statement)
     11                     (exec (sql *db* statement)))
     12                   cache-sql-schema))
    513   (define *warn-about-delete* #t)
    6    
     14
    715   (define (cache-set! key type)
    8       (if type
    9          (gdbm-store *key-cache* key (symbol->string type) GDBM_REPLACE)
    10          type)
     16      (when type
     17          (exec (sql *db* "INSERT OR REPLACE INTO cache (key, type) VALUES (?,?)") key (symbol->string type)))
    1118      type)
     19
    1220   (define (cache-get key)
    13       (let ((result (gdbm-fetch *key-cache* key)))
    14          (if result
    15             (string->symbol result)
     21      (let ((result
     22             (query fetch (sql *db* "SELECT type FROM cache WHERE key = ?") key)))
     23        (if (pair? result)
     24            (string->symbol (car result))
    1625            #f)))
     26
    1727   (define (cache-delete! key)
    18       (gdbm-delete *key-cache* key))
     28     (exec (sql *db* "DELETE FROM cache WHERE key = ?") key))
    1929
    2030   (make-storage
     
    6272      (lambda () ; close!
    6373         ((begin
    64             (gdbm-close *key-cache*)
     74            (close-database *db*)
    6575            (storage-close! be))))))
  • release/4/ugarit/trunk/backend-fs.scm

    r25477 r25478  
    11(use ugarit-backend)
    2 (use gdbm)
     2(use sql-de-lite)
    33(use srfi-69)
    44(use matchable)
     
    228228            (file-close *log*)))))
    229229
    230 (define (backend-splitlog logdir metadir max-logpart-size)
     230#;(define (backend-splitlog logdir metadir max-logpart-size)
    231231   (let*
    232232        ((*index* (gdbm-open (string-append metadir "/index")))
     
    334334                  (file-close value)))))))
    335335
     336(define splitlog-sql-schema
     337  (list
     338   "CREATE TABLE metadata (key TEXT PRIMARY KEY, value TEXT);"
     339   "INSERT INTO metadata VALUES ('version','1');"
     340   "INSERT INTO metadata VALUES ('current-logfile','0');"
     341   "CREATE TABLE blocks (key TEXT PRIMARY KEY, type TEXT, fileno INTEGER, position INTEGER, length INTEGER);"
     342   "CREATE TABLE tags (tag TEXT PRIMARY KEY, key TEXT, locked INTEGER DEFAULT 0);"))
     343
     344(define (backend-splitlog logdir metadir max-logpart-size)
     345   (let*
     346        ((*db*
     347          (let ((db (open-database (string-append metadir "/metadata"))))
     348            (when (null? (schema db))
     349                  (for-each (lambda (statement)
     350                              (exec (sql db statement)))
     351                            splitlog-sql-schema))
     352            db))
     353         (*logcount* (string->number (car (query fetch (sql *db* "SELECT value FROM metadata WHERE key = 'current-logfile'")))))
     354         (set-logcount! (lambda (newcount)
     355                         (set! *logcount* newcount)
     356                         (exec (sql *db* "INSERT OR REPLACE INTO metadata (key,value) VALUES ('current-logfile',?)") newcount)))
     357         (*log* (file-open (string-append logdir "/log" (number->string *logcount*))
     358                  (+ open/creat open/rdwr open/append) perm/irwxu))
     359         (*logfiles* (make-hash-table)) ; hash of file number to FD
     360         (get-block-data (lambda (key) ; Returns #f for nonexistant blocks
     361                           (let ((bd (query fetch (sql *db* "SELECT type, fileno, position, length FROM blocks WHERE key = ?") key)))
     362                             (if (pair? bd)
     363                                 (let ((type (string->symbol (first bd)))
     364                                       (fileno (second bd))
     365                                       (position (third bd))
     366                                       (length (fourth bd)))
     367                                   (list type fileno position length))
     368                                 #f))))
     369         (set-block-data! (lambda (key type fileno position length)
     370                           (exec (sql *db* "INSERT INTO blocks (key,type,fileno,position,length) VALUES (?,?,?,?,?)") key (symbol->string type) fileno position length)))
     371         (set-tag! (lambda (tag key)
     372                    (exec (sql *db* "INSERT OR REPLACE INTO tags (tag,key) VALUES (?,?)") tag key)))
     373         (remove-tag! (lambda (tag)
     374                        (exec (sql *db* "DELETE FROM tags WHERE tag = ?") tag)))
     375         (get-tag (lambda (tag)
     376                         (let ((td (query fetch (sql *db* "SELECT key FROM tags WHERE tag = ?") tag)))
     377                           (if (pair? td)
     378                               (car td)
     379                               #f))))
     380         (set-tag-lock! (lambda (tag lock)
     381                      (exec (sql *db* "UPDATE tags SET locked = ? WHERE tag = ?") lock tag)))
     382         (get-tag-lock (lambda (tag lock)
     383                         (let ((td (query fetch (sql *db* "SELECT locked FROM tags WHERE tag = ?") tag)))
     384                           (if (pair? td)
     385                               (car td)
     386                               #f))))
     387         (get-tags (lambda ()
     388                     (map car (query fetch-all (sql *db* "SELECT tag FROM tags")))))
     389         (get-log (lambda (index)
     390            (if (hash-table-exists? *logfiles* index)
     391               (hash-table-ref *logfiles* index)
     392               (begin
     393                  (let ((fd (file-open (string-append logdir "/log" (number->string index)) open/rdonly perm/irwxu)))
     394                     (set! (hash-table-ref *logfiles* index) fd)
     395                     fd))))))
     396
     397      ; FIXME: Sanity check that all opened OK
     398
     399      (make-storage
     400         (* 1024 1024) ; 1MiB blocks since local disk is fast and cheap
     401         #t ; We are writable
     402         #f ; We DO NOT support unlink!
     403
     404         (lambda (key data type) ; put!
     405           (with-transaction *db*
     406                             (lambda ()
     407                               (when (pair? (get-block-data key))
     408                                     (signal (make-property-condition 'exn 'message "Duplicate block: put! should not be called on an existing hash" 'arguments (list key type))))
     409
     410                               (set-file-position! *log* 0 seek/end)
     411
     412                               (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
     413                                     (posn (file-position *log*)))
     414                                 (if (> posn max-logpart-size)
     415                                     (begin
     416                                       (file-close *log*)
     417                                       (set! posn 0)
     418                                       (set-logcount! (+ *logcount* 1))
     419                                       (set! *log* (file-open (string-append logdir "/log" (number->string *logcount*))
     420                                                              (+ open/creat open/rdwr open/append) perm/irwxu))))
     421                                 (file-write *log* header)
     422                                 (file-write *log* (u8vector->blob/shared data))
     423                                 (set-block-data! key type *logcount* (+ (string-length header) posn) (u8vector-length data))
     424                                 (void)))))
     425
     426         (lambda (key) ; exists?
     427           (let ((bd (get-block-data key)))
     428             (if (pair? bd)
     429                 (car bd)
     430                 #f)))
     431
     432         (lambda (key) ; get
     433            (let* ((entry (get-block-data key)))
     434              (if (pair? entry)
     435               (let* ((type (first entry))
     436                      (index (second entry))
     437                      (position (third entry))
     438                      (length (fourth entry))
     439                      (buffer (make-blob length))
     440                      (logpart (get-log index)))
     441                 (set-file-position! logpart position seek/set)
     442                 (file-read logpart length buffer)
     443                 (blob->u8vector/shared buffer))
     444               #f)))
     445
     446         (lambda (key) ; link!
     447            (void))
     448
     449         (lambda (key) ; unlink!
     450            (signal (make-property-condition 'exn 'message "Log archives do not support deletion")))
     451
     452         (lambda (tag key) ; set-tag!
     453            (file-write *log* (sprintf "(tag ~S ~S)" tag key))
     454            (set-tag! tag key)
     455            (void))
     456         (lambda (tag) ; tag
     457           (get-tag tag))
     458         (lambda () ; all-tags
     459           (get-tags))
     460         (lambda (tag) ; remove-tag!
     461           (remove-tag! tag)
     462           (void))
     463         (lambda (tag) ; lock-tag!
     464           (set-tag-lock! tag 1)
     465           (void))
     466         (lambda (tag) ; tag-locked?
     467           (if (zero? (get-tag-lock tag))
     468               #f
     469               #t))
     470         (lambda (tag) ; unlock-tag!
     471           (set-tag-lock! tag 0))
     472         (lambda () ; close!
     473           (close-database *db*)
     474           (file-close *log*)
     475           (hash-table-for-each *logfiles*
     476                                (lambda (key value)
     477                                  (file-close value)))))))
    336478
    337479(define backend
  • release/4/ugarit/trunk/test/run.scm

    r25477 r25478  
    558558 (test "Close storage" (void) ((storage-close! be))))
    559559
    560 (test-group "Log backend"
     560#;(test-group "Log backend"
    561561 (create-directory "./tmp/be2")
    562562 (test-define "Open storage" be (import-storage "backend-fs log ./tmp/be2/log ./tmp/be2/index ./tmp/be2/tags"))
     
    584584 (test "Close archive" (void) (archive-close! be)))
    585585
    586 (test-group "Log backend archive"
     586(test-group "Filesystem backend archive plus file cache"
     587 (create-directory "./tmp/be6")
     588 (test-define "Open archive" be (open-archive '((storage "backend-fs fs ./tmp/be6") (file-cache "./tmp/be6-file-cache")) #f #t))
     589 (test-archive be "./tmp/be6")
     590 (test "Close archive" (void) (archive-close! be)))
     591
     592#;(test-group "Log backend archive"
    587593 (create-directory "./tmp/be6")
    588594 (test-define "Open archive" be (open-archive '((storage  "backend-fs log ./tmp/be6/log ./tmp/be6/index ./tmp/be6/tags")) #f #t))
     
    596602 (test "Close archive" (void) (archive-close! be)))
    597603
     604(test-group "Splitlog backend archive plus file cache"
     605 (create-directory "./tmp/be8")
     606 (test-define "Open archive" be (open-archive '((storage  "backend-fs splitlog ./tmp/be8 ./tmp/be8 1024") (file-cache "./tmp/be8-file-cache")) #f #t))
     607 (test-archive be "./tmp/be8")
     608 (test "Close archive" (void) (archive-close! be)))
     609
    598610(printf "Final count of failures: ~a\n" (test-failure-count))
    599611
  • release/4/ugarit/trunk/ugarit-core.scm

    r25477 r25478  
    100100(use regex)
    101101(use ugarit-backend)
    102 (use gdbm)
     102(use sql-de-lite)
    103103
    104104
     
    118118  decrypt ; the decryptor, inverse of the above
    119119  global-directory-rules ; top-level directory rules
    120   file-cache ; gdbm map storing filesystem cache (see store-file! procedure); #f if not enabled
     120  file-cache ; sqlite db storing filesystem cache (see store-file! procedure); #f if not enabled
    121121  file-cache-hits ; count of file cache hits
    122122  )
    123123
    124124(include "posixextras.scm")
     125
     126(define (file-cache-put! archive file-path mtime size key)
     127  (exec (sql (archive-file-cache archive)
     128             "INSERT OR REPLACE INTO files (path,mtime,size,key) VALUES (?,?,?,?)")
     129        file-path mtime size key))
     130
     131(define (file-cache-get archive file-path mtime size)
     132  (let ((data (query fetch (sql (archive-file-cache archive)
     133                                "SELECT key FROM files WHERE path = ? AND mtime = ? AND size = ?")
     134                    file-path mtime size)))
     135    (if (pair? data)
     136        (car data)
     137        #f)))
    125138
    126139(define (prepend-type-byte b v)
     
    246259                       (('encryption . conf) (set! *crypto* conf))
    247260                       (('file-cache path)
    248                         (set! *file-cache* (gdbm-open path)))
     261                        (set! *file-cache* (open-database path))
     262                        (when (null? (schema *file-cache*))
     263                              (exec (sql *file-cache* "CREATE TABLE files (path TEXT PRIMARY KEY, mtime INTEGER, size INTEGER, key TEXT);"))))
    249264                       (('rule . conf) (set! *global-rules* (cons conf *global-rules*)))
    250265                       (_ (signal (make-property-condition 'exn 'location 'open-archive 'message "Unknown configuration entry" 'arguments (list confentry))))))
     
    362377
    363378(define (archive-close! archive)
     379  (when (archive-file-cache archive)
     380        (close-database (archive-file-cache archive)))
    364381  ((storage-close! (archive-storage archive))))
    365382
     
    555572              (upload-file))))
    556573         (store-file-and-cache!
    557           (lambda (mtime)
     574          (lambda (mtime size)
    558575            (let-values (((key reused?) (store-file-without-caching!)))
    559               (gdbm-store (archive-file-cache archive)
    560                           file-path
    561                           (with-output-to-string (lambda ()
    562                                                    (write (list mtime key))))
    563                           GDBM_REPLACE)
     576              (file-cache-put! archive file-path mtime size key)
    564577              (values key reused?)))))
    565578
     
    571584    (if (archive-file-cache archive)
    572585        (let* ((mtime (vector-ref file-stat 8)) ; Should have used and-let*
    573                (cache-result-bytes (gdbm-fetch (archive-file-cache archive) file-path))
    574                (cache-result (if cache-result-bytes
    575                                  (with-input-from-string cache-result-bytes read)
    576                                  #f))
    577                (cached-mtime (if cache-result (car cache-result) #f))
    578                (cached-hash (if cache-result (cadr cache-result) #f)))
     586               (size (vector-ref file-stat 5))
     587               (cache-result (file-cache-get archive file-path mtime size)))
    579588          (if cache-result
    580               (if (= cached-mtime mtime)
    581                   (begin
    582                     #;(printf "Found ~a/~a in cache: ~a\n" file-path mtime cached-hash)
    583                     (archive-file-cache-hits-set! archive
    584                                                   (+ (archive-file-cache-hits archive) 1))
    585                     (values cached-hash #t)) ; Found in cache! Woot!
    586                   (store-file-and-cache! mtime)) ; in cache, but mtime differs
    587               (store-file-and-cache! mtime))) ; not in cache
     589              (begin
     590                (archive-file-cache-hits-set! archive
     591                                              (+ (archive-file-cache-hits archive) 1))
     592                (values cache-result #t)) ; Found in cache! Woot!
     593              (store-file-and-cache! mtime size))) ; not in cache
    588594        (store-file-without-caching!)))) ; no mtime cache
    589595
     
    805811                           (printf "~A is a socket, ignoring...\n" file-path))
    806812                          ((eq? type stat/ifreg)
    807                            ;; FIXME: We can store a gdbm cache file
    808                            ;; mapping file-path (or device+inode?) to an (mtime hash) pair
    809                            ;; We can check the filename in the cache, and if the file's mtime has not changed,
    810                            ;; consider it already uploaded and reuse the hash, thus avoiding hashing the entire file.
    811                            ;; When we upload a file, we store its mtime and hash in the cache.
    812813                           (let-values (((content-key content-reused?) (with-input-from-file file-path (lambda () (store-file! archive file-path stats)))))
    813814                             ((sexpr-stream-writer-write! ssw)
     
    11151116                            (else
    11161117                             (kons #f dirent acc)))))
    1117                        knil))))
    1118 )
     1118                       knil)))))
Note: See TracChangeset for help on using the changeset viewer.