Ugarit
Check-in [eef24a12c0]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fixed "ugarit cat", and improved resilience of splitlog's reindex! admin command.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | alaricsp
Files: files | file ages | folders
SHA1:eef24a12c03a42da1c1777cac0638f0639f4d6df
User & Date: alaric 2015-07-31 21:33:58
Context
2015-07-31
21:37
[f1f2ce8cdc] Started work on cluster backend (because I need it...) check-in: 74f9480c6a user: alaric tags: alaricsp
21:33
Fixed "ugarit cat", and improved resilience of splitlog's reindex! admin command. check-in: eef24a12c0 user: alaric tags: alaricsp
13:38
Merge from trunk, and added flushing of output on progress updates, doc updates, etc.

Sloppy to forget I'd got uncommited work when I did the merge, but now too late to undo... check-in: 235560787d user: alaric tags: alaricsp

Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to backend-fs.scm.

228
229
230
231
232
233
234






235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
...
318
319
320
321
322
323
324
325





326
327
328
329
330
331



332
333
334



335
336
337





338
339
340
341
342
343
344

         ; Log file management
         (*logcount* (string->number (get-metadata "current-logfile" "0")))
         (set-logcount! (lambda (newcount)
                         (set! *logcount* newcount)))
         (*log* (file-open (string-append logdir "/log" (number->string *logcount*))
                  (bitwise-ior open/creat open/rdwr open/append) (bitwise-ior perm/irusr perm/iwusr)))






         (*logfiles* (make-hash-table)) ; hash of file number to FD
         (get-log (lambda (index)
            (if (hash-table-exists? *logfiles* index)
               (hash-table-ref *logfiles* index)
               (begin
                  (let ((fd (file-open (string-append logdir "/log" (number->string index)) open/rdonly perm/irwxu)))
                     (set! (hash-table-ref *logfiles* index) fd)
                     fd)))))

         ; Basic configurables
         (block-size (string->number (get-metadata "block-size" "1048576")))
         (writable? (not (string=? "0" (get-metadata "writable" "1"))))
         (check-writable (lambda ()
                           (unless writable?
                                   (error "This archive is write protected"))))
................................................................................
                       (let* ((log-file-name (string-append logdir "/log" (number->string log-number))))
                         (if (file-exists? log-file-name)
                          (begin
                            ((backend-log!) 'info (sprintf "Reading ~a" log-file-name))
                            (with-input-from-file log-file-name
                              (lambda ()
                                (let loop-over-entries ()
                                  (let* ((entry (read))





                                         (posn (file-position (current-input-port))))
                                    (if (eof-object? entry)
                                        (loop-over-logs (+ log-number 1))
                                        (begin
                                          (match entry
                                                 (('block key type length)



                                                  (set-block-data! key type log-number posn length)
                                                  (set-file-position! (current-input-port) length seek/cur))
                                                 (('tag tag key)



                                                  (set-tag! tag key))
                                                 (else
                                                  ((backend-log!) 'error "Unknown log entry ~S" entry)))





                                          (loop-over-entries)))))))))
                         (void)))
                     (flush!)
                     (void))))

      (make-storage
         block-size







>
>
>
>
>
>





|
|
|







 







|
>
>
>
>
>






>
>
>
|


>
>
>
|

<
>
>
>
>
>







228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353

354
355
356
357
358
359
360
361
362
363
364
365

         ; Log file management
         (*logcount* (string->number (get-metadata "current-logfile" "0")))
         (set-logcount! (lambda (newcount)
                         (set! *logcount* newcount)))
         (*log* (file-open (string-append logdir "/log" (number->string *logcount*))
                  (bitwise-ior open/creat open/rdwr open/append) (bitwise-ior perm/irusr perm/iwusr)))

         ;; FIXME: GC this hash. Keep an LRU list and a maximum size,
         ;; and zap the least recently used one to make room. Perhaps
         ;; a fixed-size vector of FDs with a wrapping pointer moving
         ;; through it, and the hash maps from indexes to vector
         ;; indices, would do the trick.
         (*logfiles* (make-hash-table)) ; hash of file number to FD
         (get-log (lambda (index)
            (if (hash-table-exists? *logfiles* index)
               (hash-table-ref *logfiles* index)
               (begin
                 (let ((fd (file-open (string-append logdir "/log" (number->string index)) open/rdonly perm/irwxu)))
                   (set! (hash-table-ref *logfiles* index) fd)
                   fd)))))

         ; Basic configurables
         (block-size (string->number (get-metadata "block-size" "1048576")))
         (writable? (not (string=? "0" (get-metadata "writable" "1"))))
         (check-writable (lambda ()
                           (unless writable?
                                   (error "This archive is write protected"))))
................................................................................
                       (let* ((log-file-name (string-append logdir "/log" (number->string log-number))))
                         (if (file-exists? log-file-name)
                          (begin
                            ((backend-log!) 'info (sprintf "Reading ~a" log-file-name))
                            (with-input-from-file log-file-name
                              (lambda ()
                                (let loop-over-entries ()
                                  (let* ((entry (handle-exceptions
                                                 exn
                                                 (begin
                                                   ((backend-log!) 'error (sprintf "Exception reading header ~S in ~S at ~S" (describe-exception exn) log-file-name (file-position (current-input-port))))
                                                   #!eof)
                                                 (read)))
                                         (posn (file-position (current-input-port))))
                                    (if (eof-object? entry)
                                        (loop-over-logs (+ log-number 1))
                                        (begin
                                          (match entry
                                                 (('block key type length)
                                                  (handle-exceptions
                                                   exn
                                                   ((backend-log!) 'error (sprintf "Exception updating block ~S: ~S in ~S at ~S" entry (describe-exception exn) log-file-name (file-position (current-input-port))))
                                                   (set-block-data! key type log-number posn length))
                                                  (set-file-position! (current-input-port) length seek/cur))
                                                 (('tag tag key)
                                                  (handle-exceptions
                                                   exn
                                                   ((backend-log!) 'error (sprintf "Exception updating tag ~S: ~S in ~S at ~S" entry (describe-exception exn) log-file-name (file-position (current-input-port))))
                                                   (set-tag! tag key)))
                                                 (else

						  ;; FIXME: This happens when a log header is corrupted.
						  ;; Rather than just trying to read again, which will produce a stream of errors
						  ;; until we re-synchronise, we should go into a loop that looks for a likely log
						  ;; entry.
                                                  ((backend-log!) 'error (sprintf "Unknown log entry ~S in ~S at ~S" entry log-file-name (file-position (current-input-port))))))
                                          (loop-over-entries)))))))))
                         (void)))
                     (flush!)
                     (void))))

      (make-storage
         block-size

Changes to ugarit-api.scm.

4
5
6
7
8
9
10

11
12
13
14
15
16
17
  vault-close!
  vault-fork-tag!

  ;; Re-exports from ugarit-core
  vault?
  vault-global-directory-rules
  vault-admin!


  make-job
  job?
  job-blocks-stored
  job-bytes-stored
  job-blocks-skipped
  job-bytes-skipped







>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  vault-close!
  vault-fork-tag!

  ;; Re-exports from ugarit-core
  vault?
  vault-global-directory-rules
  vault-admin!
  vault-exists? vault-get

  make-job
  job?
  job-blocks-stored
  job-bytes-stored
  job-blocks-skipped
  job-bytes-skipped

Changes to ugarit-backend.scm.

22
23
24
25
26
27
28


29
30
31
32
33
34
35
         storage-close!

         backend-log!

         export-storage! ; Export a storage via stdin/stdout
         export-storage-error!
         import-storage ; Create a storage from a command line


         )

(import scheme)
(import chicken)

(use extras)
(use ports)







>
>







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
         storage-close!

         backend-log!

         export-storage! ; Export a storage via stdin/stdout
         export-storage-error!
         import-storage ; Create a storage from a command line

         describe-exception ; Doesn't really belong here...
         )

(import scheme)
(import chicken)

(use extras)
(use ports)