Changeset 20740 in project


Ignore:
Timestamp:
10/09/10 00:36:31 (11 years ago)
Author:
Alaric Snell-Pym
Message:

ugarit: Initial support for out-of-process backends (not yet well tested...)

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

Legend:

Unmodified
Added
Removed
  • release/4/ugarit/trunk/backend-devtools.scm

    r16950 r20740  
    1 (define (backend-nullwrap be)
     1 (define (backend-nullwrap be)
    22   (make-storage
    33      (storage-max-block-size be)
  • release/4/ugarit/trunk/backend-fs.scm

    r15242 r20740  
     1(use ugarit-backend)
    12(use gdbm)
    23(use srfi-69)
     4(use matchable)
    35
    46(define (backend-fs base)
     
    3335            (if (and (directory? path) (null? (directory path)))
    3436               (delete-directory path)))))
    35                
     37
    3638         (if (>= (string-length key) 10)
    3739            (dd (string-append base "/" (string-take key 3) "/" (string-take (string-drop key 3) 3) "/" (string-take (string-drop key 6) 3))))
     
    4749   (if (not (directory? base))
    4850      (signal (make-property-condition 'exn 'message "The archive does not exist" 'arguments base)))
    49    
     51
    5052   (make-storage
    5153      (* 1024 1024) ; 1MiB blocks since local disk is fast and cheap
     
    110112                     (delete-dir-if-empty! key)
    111113                     data)) ; returned in case of deletion
    112                (begin 
     114               (begin
    113115                  (with-output-to-file (make-name key ".refcount~")
    114116                     (lambda () (write new-refcount)))
     
    158160         (parse-index-entry (lambda (str)
    159161            (with-input-from-string str read))))
    160      
     162
    161163      ; FIXME: Sanity check that all opened OK
    162164
     
    165167         #t ; We are writable
    166168         #f ; We DO NOT support unlink!
    167          
     169
    168170         (lambda (key data type) ; put!
    169171            (if (gdbm-exists *index* (make-index-key key))
    170172               (signal (make-property-condition 'exn 'message "Duplicate block: put! should not be called on an existing hash" 'arguments (list key type))))
    171            
     173
    172174            (set-file-position! *log* 0 seek/end)
    173            
    174            
     175
     176
    175177            (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
    176178                  (posn (file-position *log*)))
     
    251253         (parse-index-entry (lambda (str)
    252254            (with-input-from-string str read))))
    253      
     255
    254256      ; FIXME: Sanity check that all opened OK
    255257
     
    258260         #t ; We are writable
    259261         #f ; We DO NOT support unlink!
    260          
     262
    261263         (lambda (key data type) ; put!
    262264            (if (gdbm-exists *index* (make-index-key key))
    263265               (signal (make-property-condition 'exn 'message "Duplicate block: put! should not be called on an existing hash" 'arguments (list key type))))
    264            
     266
    265267            (set-file-position! *log* 0 seek/end)
    266            
     268
    267269            (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
    268270                  (posn (file-position *log*)))
     
    330332               (lambda (key value)
    331333                  (file-close value)))))))
    332      
    333    
     334
     335
     336(define backend
     337  (match (command-line-arguments)
     338         (("fs" base)
     339          (backend-fs base))
     340
     341         (("log" logfile indexfile tagsfile)
     342          (backend-log logfile indexfile tagsfile))
     343
     344         (("splitlog" logdir metadir max-logpart-size)
     345          (backend-splitlog logdir metadir max-logpart-size))
     346
     347         (else
     348          (printf "USAGE:\nbackend-fs fs <basedir>\nbackend-fs log <logfile> <indexfile> <tagsfile>\nbackend-fs splitlog <logdir> <metadir> <max-file-size>\n")
     349          #f)))
     350
     351(if backend
     352    (export-storage! backend))
  • release/4/ugarit/trunk/ugarit-core.scm

    r20322 r20740  
    7575(use matchable)
    7676(use regex)
    77 
    78 ;;
    79 ;; STORAGE ENGINES
    80 ;;
    81 
    82 (define-record storage
    83   max-block-size  ; Integer: largest size of block we can store
    84   writable? ; Boolean: Can we call put!, link!, unlink!, set-tag!, lock-tag!, unlock-tag!?
    85   unlinkable? ; Boolean: Can we call unlink?
    86   put! ; Procedure: (put key data type) - stores the data (u8vector) under the key (string) with the given type tag (symbol) and a refcount of 1. Does nothing of the key is already in use.
    87   exists? ; Procedure: (exists? key) - returns the type of the block with the given key if it exists, or #f otherwise
    88   get ; Procedure: (get key) - returns the contents (u8vector) of the block with the given key (string) if it exists, or #f otherwise
    89   link! ; Procedure: (link key) - increments the refcount of the block
    90   unlink! ; Procedure: (unlink key) - decrements the refcount of the block. If it's now zero, deletes it but returns its value as a u8vector. If not, returns #f.
    91   set-tag! ; Procedure: (set-tag! name key) - assigns the given key (string) to the given tag (named with a string). Creates a new tag if the name has not previously been used, otherwise updates an existing tag
    92   tag ; Procedure: (tag name) - returns the key assigned to the given tag, or #f if it does not exist.
    93   all-tags ; Procedure: (all-tags) - returns a list of all existing tag names
    94   remove-tag! ; Procedure: (remove-tag! name) - removes the named tag
    95   lock-tag! ; Procedure: (lock-tag! name) - locks the named tag, or blocks if already locked
    96   tag-locked? ; Procedure: (tag-locked? name) - returns the locker identity string if the tag is locked, #f otherwise
    97   unlock-tag! ; Procedure: (unlock-tag! name) - unlocks the named tag
    98   close!)  ; Procedure: (close!) - closes the storage engine
     77(use ugarit-backend)
     78(use gdbm)
     79
    9980
    10081;;
     
    11899
    119100(include "posixextras.scm")
    120 (include "backend-fs.scm")
    121 (include "backend-cache.scm")
    122 (include "backend-devtools.scm")
    123101
    124102(define (prepend-type-byte b v)
     
    238216                (match confentry
    239217                       ('double-check (set! *double-check?* #t))
    240                        (('storage 'fs path) (set! *storage* ; FIXME: Split this into a plugin registry thingy
    241                                                   (backend-fs path)))
    242                        (('storage 'log logpath indexpath tagspath) (set! *storage*
    243                                                                          (backend-log logpath indexpath tagspath)))
    244                        (('storage 'splitlog logdir metadir maxlen) (set! *storage*
    245                                                                          (backend-splitlog logdir metadir maxlen)))
    246                        (('storage 'debug 'fs path) (set! *storage*
    247                                                          (backend-debug (backend-fs path) "DEBUG")))
     218                       (('storage command-line)
     219                        (set! *storage* (import-storage command-line)))
    248220                       (('hash . conf) (set! *hash* conf))
    249221                       (('compression . conf) (set! *compression* conf))
  • release/4/ugarit/trunk/ugarit.setup

    r20269 r20740  
    66  '((version 0.7)
    77    (static "directory-rules.o")))
     8
     9(compile -s -O2 -d1 ugarit-backend.scm -j ugarit-backend)
     10(compile -s -O2 -d1 ugarit-backend.import.scm)
     11(compile -c -O2 -d1 ugarit-backend.scm -unit ugarit-backend)
     12
     13(install-extension 'ugarit-backend '("ugarit-backend.so" "ugarit-backend.o" "ugarit-backend.import.so")
     14  '((version 0.7)
     15    (static "ugarit-backend.o")))
    816
    917(compile -s -O2 -d1 ugarit-core.scm -j ugarit-core)
     
    1523    (static "ugarit-core.o")))
    1624
     25(compile backend-fs.scm)
     26(install-program 'backend-fs "backend-fs"
     27  '((version 0.7)))
     28
    1729(compile ugarit.scm)
    1830(install-program 'ugarit "ugarit"
Note: See TracChangeset for help on using the changeset viewer.