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
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)
|