Changeset 25565 in project


Ignore:
Timestamp:
11/24/11 00:25:57 (9 years ago)
Author:
Alaric Snell-Pym
Message:

ugarit: tag locking, and strict enforcement of maximum file size in splitlog archives

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

Legend:

Unmodified
Added
Removed

  • release/4/ugarit/trunk/README.txt

    r25555 r25565  
    827827## Backends
    828828
     829* Create ugarit-backend-protocol-2, and extend import-backend to
     830  support it. The differences are:
     831
     832  * Extend the backend API to have all API calls return a possibly
     833    empty list of log messages before the actual result. When
     834    importing a backend, provide a logging callback which is passed
     835    these lists and feeds them into a logging mechanism which prints
     836    them and stores them in the archive object for later logging into
     837    the snapshot. The same logging interface can then be used for
     838    warnings from within ugarit-core itself as well.
     839
     840  * Extend the backend API to have an initial list of log messages and
     841    a possible error or success for initialisation, inside the
     842    header. Make the command-line wrappers for backends use this to
     843    indicate startup failure.
     844
    829845* Carefully document backend API for other backend authors: in
    830846  particular note behaviour in crash situations - we assume that after
    … …  
    835851  (see v1.0.2).
    836852
    837 * Make splitlog see if writing the block will go over the log file
    838   size limit, and if so, start a new file - rather than testing AFTER
    839   writing, leading to a potential extra partial block beyond the
    840   limit. It'd be nice to make it a hard limit.
    841 
    842 * Implement lock-tag! etc. in backend-fs, as a precaution against two
    843   concurrent snapshots racing over updating the tag, where concurrent
    844   access to the archive is even possible.
    845 
    846853* Lock the archive for writing in backend-splitlog, so that two
    847854  snapshots to the same archive don't collide. Do we lock per `put!`
    … …  
    857864  to find (complete) blocks that did not get flushed to the metadata.
    858865
    859 * Make `lock-tag!` in backend-splitlog actually block until the tag is
    860   not already locked! With a timeout and an apologetic error message
    861   if it takes too long.
     866* Make `lock-tag!` fail if the tag is already locked. Make the archive
     867  block and retry a few times in that case.
    862868
    863869* Extend the backend protocol with a special "admin" command that
    … …  
    970976  quick summary of the bytes/blocks stored/skipped stats.
    971977
    972 * Log all WARNINGs produced during a snapshot job, and attach them to
    973   the snapshot object as a text file.
    974 
    975978* Clarify what characters are legal in tag names sent to backends, and
    976979  what are legal in human-supplied tag names, and check that
    … …  
    10801083  between archives, perhaps to change to a better backend.
    10811084
     1085* Optional progress reporting callback from within store-file! and
     1086  store-directory!, called on each block within a file or on each
     1087  filesystem object, respectively.
     1088
     1089* Add a procedure to resolve a path within the archive node tree from
     1090  any root node. Pass in the path as a list of strings, with the
     1091  symbols `.` and `..` being usable as meta-characters to do nothing
     1092  or to go up a level. Write a utility procedure to parse a string
     1093  into such a form.
     1094
    10821095## Front-end
    10831096
     1097* Install progress reporting callbacks to report progress to user;
     1098  option for quiet (no reporting), normal (reporting if >60s have
     1099  passed since last time), or verbose (report every file), or very
     1100  verbose (report every file and block).
     1101
    10841102* Add a command to force removing a tag lock.
    10851103
    10861104* Add a command to list all the tags (with a * next to locked tags)
     1105
     1106* Add a command to list the contents of any directory in the archive
     1107  node tree
    10871108
    10881109* Better error messages
    … …  
    11321153  and restore the corpus several times over with each hash,
    11331154  compression, and encryption option.
     1155
     1156* Testing crashes. See about writing a test backend binary that either
     1157  raises an error or just kills the process directly after N
     1158  operations, and sit in a loop running it with increasing N. Take N
     1159  from an environment variable to make it easier to automate this.
     1160
     1161* Extract the debugging backend from backend-devtools into a proper
     1162  backend binary that takes a path to a log file and a backend command
     1163  line to wrap.
    11341164
    11351165# Acknowledgements
    … …  
    12191249  when tagging a snapshot) so that we ensure the blocks we point at
    12201250  are flushed before committing references to them in the
    1221   `backend-cache` or file caches, or into tags, to ensure crash safety.
     1251  `backend-cache` or file caches, or into tags, to ensure crash
     1252  safety. BUGFIX: Made the splitlog backend never exceed the file size
     1253  limit (except when passed blocks that, plus a header, are larger
     1254  than it), rather than letting a partial block hang over the
     1255  'end'. BUGFIX: Fixed tag locking, which was broken all over the
     1256  place. Concurrent snapshots to the same tag should now block for one
     1257  another, although why you'd want to *do* that is questionable.
    12221258
    12231259* 1.0.1: Consistency check on read blocks by default. Removed warning

  • release/4/ugarit/trunk/backend-cache.scm

    r25555 r25565  
    9494         (flush!))
    9595      (lambda (tag) ; lock-tag!
    96          ((storage-lock-tag! be) tag)
    97          ((storage-flush! be))
    98          (flush!))
     96         (let ((result ((storage-lock-tag! be) tag)))
     97           ((storage-flush! be))
     98           (flush!)
     99           result))
    99100      (lambda (tag) ; tag-locked?
    100101         ((storage-tag-locked? be) tag))

  • release/4/ugarit/trunk/backend-devtools.scm

    r25555 r25565  
    120120            ((storage-remove-tag! be) tag)))
    121121      (lambda (tag) ; lock-tag!
    122          (begin
    123             (printf "~A: (lock-tag! ~A)\n" name tag)
    124             ((storage-lock-tag! be) tag)))
     122        (let ((result ((storage-lock-tag! be) tag)))
     123          (begin
     124            (printf "~A: (lock-tag! ~A) = ~A\n" name tag result)
     125            result)))
    125126      (lambda (tag) ; tag-locked?
    126127         (let ((result ((storage-tag-locked? be) tag)))

  • release/4/ugarit/trunk/backend-fs.scm

    r25555 r25565  
    4848   (define (make-tag-name tag)
    4949      (string-append base "/" tag ".tag"))
     50
     51   (define (make-tag-lock-name tag)
     52      (string-append base "/" tag ".tag-lock"))
    5053
    5154   (if (not (directory? base))
    … …  
    126129         (if (file-read-access? (make-tag-name tag))
    127130            (with-input-from-file (make-tag-name tag)
    128                (lambda () (read)))
     131               (lambda () (let ((key (read)))
     132                            (if (eof-object? key)
     133                                #f ; Treat empty file as no tag
     134                                key))))
    129135            #f))
    130136      (lambda () ; all-tags
    … …  
    137143      (lambda (tag) ; remove-tag!
    138144         (if (file-write-access? (make-tag-name tag))
    139             (delete-file (make-tag-name tag))
     145            (begin
     146              (delete-file (make-tag-name tag))
     147              (when (file-exists? (make-tag-lock-name tag))
     148                    (delete-file (make-tag-lock-name tag))))
    140149            #f))
    141150      (lambda (tag) ; lock-tag!
    142          ; (printf "FIXME: Implement lock-tag! in backend-fs.scm\n")
    143          #f)
     151        ; Ensure tag file exists first, as an empty file if necessary
     152        (file-close (file-open (make-tag-name tag) (+ open/wronly open/append open/creat)))
     153        (condition-case
     154         (begin
     155           (file-link (make-tag-name tag) (make-tag-lock-name tag))
     156           #t)
     157         ((exn i/o file)
     158          #f)))  ; If we can't create it for any reason, we haven't got the lock; it'd be nicer to check errno = EEXIST, though, and raise an exception for other errors.
    144159      (lambda (tag) ; tag-locked?
    145          ; (printf "FIXME: Implement tag-locked? in backend-fs.scm\n")
    146          #f)
     160        (not (not (file-exists? (make-tag-lock-name tag)))))
    147161      (lambda (tag) ; unlock-tag!
    148          ; (printf "FIXME: Implement unlock-tag! in backend-fs.scm\n")
    149          #f)
     162        (delete-file (make-tag-lock-name tag))
     163        (void))
    150164      (lambda () ; close!
    151165         (void))))
    … …  
    248262                         (let ((td (query fetch get-tag-query tag)))
    249263                           (if (pair? td)
    250                                (car td)
     264                               (if (null? (car td)) ; treat NULL as no tag
     265                                   #f
     266                                   (car td))
    251267                               #f))))
    252268
    … …  
    259275                           (if (pair? td)
    260276                               (car td)
    261                                #f))))
     277                               (begin ; Tag does not exist, create it on demand
     278                                 (set-tag! tag '()) ; insert NULL tag record
     279                                 0)))))
    262280
    263281         (get-tags (lambda ()
    … …  
    277295           (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
    278296                 (posn (file-position *log*)))
    279              (if (> posn max-logpart-size)
     297             (if (and (not (zero? posn)) (> (+ (u8vector-length data) (string-length header) posn) max-logpart-size))
    280298                 (begin
    281299                   (file-close *log*)
    … …  
    331349           (void))
    332350         (lambda (tag) ; lock-tag!
    333            (set-tag-lock! tag 1)
    334            (void))
     351           (flush!)
     352           (let ((existing-lock? (not (zero? (get-tag-lock tag)))))
     353             (if existing-lock?
     354                 (begin
     355                   #f)
     356                 (begin
     357                   (set-tag-lock! tag 1)
     358                   (flush!)
     359                   #t))))
    335360         (lambda (tag) ; tag-locked?
    336361           (if (zero? (get-tag-lock tag))
    … …  
    338363               #t))
    339364         (lambda (tag) ; unlock-tag!
    340            (set-tag-lock! tag 0))
     365           (set-tag-lock! tag 0)
     366           (flush!))
    341367         (lambda () ; close!
    342368           (flush!)

  • release/4/ugarit/trunk/test/run.scm

    r25555 r25565  
    4949         (test-assert "Unlinked block is gone" (not ((storage-exists? w) "TEST")))))
    5050   (test "Set a tag" (void) ((storage-set-tag! w) "TEST" "TEST123"))
     51   (test "Tag is not locked" #f ((storage-tag-locked? w) "TEST"))
     52   (test "Lock a tag" #t ((storage-lock-tag! w) "TEST"))
     53   (test "Tag is now locked" #t ((storage-tag-locked? w) "TEST"))
     54   (test "Lock a tag again" #f ((storage-lock-tag! w) "TEST"))
     55   (test "Tag is still locked" #t ((storage-tag-locked? w) "TEST"))
     56   (test "Unlock a tag" (void) ((storage-unlock-tag! w) "TEST"))
     57   (test "Tag is no longer locked" #f ((storage-tag-locked? w) "TEST"))
    5158   (test "Tag reads back" "TEST123" ((storage-tag w) "TEST"))
    5259   (test "Tag list works" (list "TEST") ((storage-all-tags w)))
    … …  
    135142                     (test-assert "Unlinked data is gone" (not (archive-exists? a test-key)))))
    136143               (test "Tag setting" (void) (archive-set-tag! a "TEST" test-key))
     144
     145               (test "Tag is not locked" #f (archive-tag-locked? a "TEST"))
     146               (test "Lock a tag" #t (archive-lock-tag! a "TEST"))
     147               (test "Tag is now locked" #t (archive-tag-locked? a "TEST"))
     148               (test-error "Lock a tag again" (archive-lock-tag! a "TEST"))
     149               (test "Tag is still locked" #t (archive-tag-locked? a "TEST"))
     150               (test "Unlock a tag" (void) (archive-unlock-tag! a "TEST"))
     151               (test "Tag is no longer locked" #f (archive-tag-locked? a "TEST"))
     152
    137153               (test "Tag reading" test-key (archive-tag a "TEST"))
    138154               (test "Tag listing" (list "TEST") (archive-all-tags a))
    … …  
    473489                                     (tag-snapshot! a "Test" dir2-key dir2-reused? (list)))
    474490
     491                 (test-define-values "Read the tag back" (tag2) (archive-tag a "Test"))
    475492                 (test-define-values "Walk the history with fold-history" (result)
    476                                      (fold-history a (archive-tag a "Test")
     493                                     (fold-history a tag2
    477494                                                   (lambda (snapshot-key snapshot acc)
    478495                                                     (cons snapshot acc))

  • release/4/ugarit/trunk/ugarit-backend.scm

    r25555 r25565  
    4747  all-tags ; Procedure: (all-tags) - returns a list of all existing tag names
    4848  remove-tag! ; Procedure: (remove-tag! name) - removes the named tag
    49   lock-tag! ; Procedure: (lock-tag! name) - locks the named tag, or blocks if already locked
    50   tag-locked? ; Procedure: (tag-locked? name) - returns the locker identity string if the tag is locked, #f otherwise
     49  lock-tag! ; Procedure: (lock-tag! name) - locks the named tag, returning #t if all went well, or #f if it can't be locked.
     50  tag-locked? ; Procedure: (tag-locked? name) - returns #t if the tag is locked, #f otherwise
    5151  unlock-tag! ; Procedure: (unlock-tag! name) - unlocks the named tag
    5252  close!)  ; Procedure: (close!) - closes the storage engine
    … …  
    163163           (('lock-tag! name)
    164164            (with-error-reporting
    165              ((storage-lock-tag! storage) name)
    166              (write #t))
     165             (let  ((result ((storage-lock-tag! storage) name)))
     166               (write result)))
    167167            (loop))
    168168
    … …  
    289289              (if debug (printf "~a: lock-tag!" command-line))
    290290              (write `(lock-tag! ,name) commands)
    291               (read-response responses)
    292               (void))
     291              (read-response responses))
    293292
    294293            (lambda (name)              ; tag-locked?

  • release/4/ugarit/trunk/ugarit-core.scm

    r25555 r25565  
    411411  (if (not (archive-writable? archive))
    412412      (signal (make-property-condition 'exn 'location 'archive-lock-tag! 'message "This isn't a writable archive")))
    413   ((storage-lock-tag! (archive-storage archive)) tag))
     413  (let loop ((tries-left 10))
     414    (if (zero? tries-left)
     415        (signal (make-property-condition 'exn 'location 'archive-lock-tag! 'message (sprintf "We timed out attempting to lock the tag '~A'" tag)))
     416        (let ((result ((storage-lock-tag! (archive-storage archive)) tag)))
     417          (if result
     418              result                       ; Lock got!
     419              (begin
     420                (thread-sleep! 1)
     421                (loop (- tries-left 1))))))))
    414422
    415423(define (archive-tag-locked? archive tag)
    … …  
    844852       (for-each (lambda (filename)
    845853                   (handle-exceptions exn
    846                                       (printf "ERROR: Could not store ~a into the archive, skipping it...\n" (make-pathname path filename))
     854                                      (printf "ERROR: Could not store ~a into the archive (~a), skipping it...\n" (make-pathname path filename) ((condition-property-accessor 'exn 'message "Unknown error") exn))
    847855                                      (let* ((file-path (make-pathname path filename))
    848856                                             (stats (file-stat file-path #t))
    … …  
    10721080(define (tag-snapshot! archive tag contents-key contents-reused? snapshot-properties)
    10731081  (check-archive-writable archive)
    1074   (archive-lock-tag! archive tag)
     1082  (archive-lock-tag! archive tag) ;; Lock BEFORE reading previous state of the tag, to avoid races.
    10751083  (let* ((previous (archive-tag archive tag))
    10761084         (stats (list
    … …  
    10911099          (list ; We do not list the previous snapshot - since we are about to overwrite the tag that points to it, which would be a decrement.
    10921100           (cons contents-key contents-reused?))))
    1093     (if previous
    1094         (begin
    1095           (set! snapshot (cons
    1096                           (cons 'previous previous)
    1097                           snapshot))))
     1101    (when previous
     1102          (set! snapshot (cons
     1103                          (cons 'previous previous)
     1104                          snapshot)))
    10981105    (let-values (((snapshot-key snapshot-reused?)
    10991106                  (store-sexpr! archive snapshot 'snapshot keys)))
    … …  
    11011108      (archive-set-tag! archive tag snapshot-key) ; Therefore, we can be confident in saving it in a tag.
    11021109      (archive-unlock-tag! archive tag)
     1110      (when snapshot-reused? ; Rare, but possible; fork a tag then snapshot the same FS state to both at the same second.
     1111            (archive-link! archive snapshot-key))
    11031112      snapshot-key)))
    11041113
Note: See TracChangeset for help on using the changeset viewer.