Ignore:
Timestamp:
11/20/11 18:11:42 (10 years ago)
Author:
Alaric Snell-Pym
Message:

ugarit: Tracking archive space usage stats. Also migrated to using the miscmacros inc! macro to increment all those pesky counters nicely.

File:
1 edited

Legend:

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

    r25525 r25527  
    44         archive-hash
    55         archive-global-directory-rules
     6         archive-snapshot-blocks-stored
     7         archive-snapshot-bytes-stored
     8         archive-snapshot-blocks-skipped
     9         archive-snapshot-bytes-skipped
    610         archive-file-cache-hits
     11         archive-file-cache-bytes
    712         archive-writable?
    813         archive-unlinkable?
     
    105110;;
    106111;; THE ARCHIVE
     112;; This thing is becoming a bit of a God Object. Figure out how to
     113;; refactor it a bit, perhaps?
    107114;;
    108115
     
    118125  decrypt ; the decryptor, inverse of the above
    119126  global-directory-rules ; top-level directory rules
     127
     128  ; Snapshot counters
     129  (setter snapshot-blocks-stored)              ; Blocks written to storage
     130  (setter snapshot-bytes-stored)               ; Bytes written to storage
     131  (setter snapshot-blocks-skipped)             ; Blocks already in storage and reused (not including file cache wins)
     132  (setter snapshot-bytes-skipped)              ; Bytes already in storage and reused (not including file cache wins)
     133
     134  ; File cache
    120135  file-cache ; sqlite db storing filesystem cache (see store-file! procedure); #f if not enabled
    121136  file-cache-get-query ; sqlite stored procedure
    122137  file-cache-set-query ; sqlite stored procedure
    123   file-cache-updates-uncommitted ; count of updates since last commit
    124   file-cache-hits ; count of file cache hits
     138  (setter file-cache-updates-uncommitted) ; count of updates since last commit
     139  (setter file-cache-hits)              ; count of file cache hits
     140  (setter file-cache-bytes)                 ; count of file cache bytes saved
    125141  )
    126142
     
    133149        (exec (sql (archive-file-cache archive) "commit;"))
    134150        (exec (sql (archive-file-cache archive) "begin;"))
    135         (archive-file-cache-updates-uncommitted-set! archive 0))
     151        (set! (archive-file-cache-updates-uncommitted archive) 0))
    136152  (exec (archive-file-cache-set-query archive)
    137         file-path mtime size key))
     153        file-path mtime size key)
     154  (inc! (archive-file-cache-updates-uncommitted archive)))
    138155
    139156(define (file-cache-get archive file-path mtime size)
     
    295312       decrypt
    296313       *global-rules*
     314       ; Snapshot counters
     315       0 0 0 0
     316       ; File cache
    297317       *file-cache*
    298318       (if *file-cache* (sql *file-cache* "SELECT key FROM files WHERE path = ? AND mtime = ? AND size = ?") #f)
    299319       (if *file-cache* (sql *file-cache* "INSERT OR REPLACE INTO files (path,mtime,size,key) VALUES (?,?,?,?)") #f)
    300        0 0))))
     320       0 0 0))))
    301321
    302322                                        ; Take a block, and return a compressed and encrypted block
     
    327347      (signal (make-property-condition 'exn 'location 'check-archive-unlinkable 'message "This isn't an unlinkable archive - it's append-only"))))
    328348
     349(define (archive-log-reuse! archive data)
     350  (inc! (archive-snapshot-blocks-skipped archive))
     351  (inc! (archive-snapshot-bytes-skipped archive) (u8vector-length data)))
     352
    329353(define (archive-put! archive key data type)
    330   (if (not (archive-writable? archive))
     354  (when (not (archive-writable? archive))
    331355      (signal (make-property-condition 'exn 'location 'archive-put! 'message "This isn't a writable archive")))
    332   ((storage-put! (archive-storage archive)) key (wrap-block archive data) type))
     356  ((storage-put! (archive-storage archive)) key (wrap-block archive data) type)
     357  (inc! (archive-snapshot-blocks-stored archive))
     358  (inc! (archive-snapshot-bytes-stored archive) (u8vector-length data))
     359  (void))
    333360
    334361(define (archive-exists? archive key)
     
    426453
    427454    (if (archive-exists? archive hash)
    428         (values (reusing hash) #t)
     455        (begin
     456          (archive-log-reuse! archive data)
     457          (values (reusing hash) #t))
    429458        (begin
    430459          (archive-put! archive hash data type)
     
    477506                             (set! *key-buffer-bytes* 0)
    478507                             (set! *key-buffer-reused?* #t)
     508                             (archive-log-reuse! archive keys-serialised)
    479509                             (values (reusing hash) #t)) ; We, too, are reused
    480510                           (begin ; We are unique and new and precious!
     
    599629          (if cache-result ;; FIXME: This assumes that the cached file IS in the archive. Give a configurable option to make it check this, making the file-cache a file hash cache rather than also being an archive presence cache like backend-cache as well, for safety.
    600630              (begin
    601                 (archive-file-cache-hits-set! archive
    602                                               (+ (archive-file-cache-hits archive) 1))
     631                (inc! (archive-file-cache-hits archive))
     632                (inc! (archive-file-cache-bytes archive) size)
    603633                (values cache-result #t)) ; Found in cache! Woot!
    604634              (store-file-and-cache! mtime size))) ; not in cache
     
    666696                                 (set! *key-buffer* '())
    667697                                 (set! *key-buffer-reused?* #t)
     698                                 (archive-log-reuse! archive serialised-buffer)
    668699                                 (values (reusing hash) #t)) ; We, too, are reused
    669700                               (begin ; We are unique and new and precious!
     
    9931024
    9941025    (if (archive-exists? archive hash)
    995         (values (reusing hash) #t)
     1026        (begin
     1027          (archive-log-reuse! archive data)
     1028          (values (reusing hash) #t))
    9961029        (begin
    9971030          (for-each (lambda (key)
     
    10171050;; 'notes (user-supplied notes)
    10181051;; 'previous (hash of previous snapshot)
     1052;; 'stats (alist of stats:
     1053;;         'blocks-stored
     1054;;         'bytes-stored
     1055;;         'blocks-skipped
     1056;;         'bytes-skipped
     1057;;         'file-cache-hits
     1058;;         'file-cache-bytes
    10191059;; Returns the snapshot's key.
    10201060(define (tag-snapshot! archive tag contents-key contents-reused? snapshot-properties)
    10211061  (check-archive-writable archive)
    10221062  (archive-lock-tag! archive tag)
    1023   (let ((previous (archive-tag archive tag))
    1024         (snapshot
    1025          (append
    1026           (list
    1027            (cons 'mtime (current-seconds))
    1028            (cons 'contents contents-key))
    1029           snapshot-properties))
    1030         (keys
    1031          (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.
    1032           (cons contents-key contents-reused?))))
     1063  (let* ((previous (archive-tag archive tag))
     1064         (stats (list
     1065                 (cons 'blocks-stored (archive-snapshot-blocks-stored archive))
     1066                 (cons 'bytes-stored (archive-snapshot-bytes-stored archive))
     1067                 (cons 'blocks-skipped (archive-snapshot-blocks-skipped archive))
     1068                 (cons 'bytes-skipped (archive-snapshot-bytes-skipped archive))
     1069                 (cons 'file-cache-hits (archive-file-cache-hits archive))
     1070                 (cons 'file-cache-bytes (archive-file-cache-bytes archive))))
     1071         (snapshot
     1072          (append
     1073           (list
     1074            (cons 'mtime (current-seconds))
     1075            (cons 'contents contents-key)
     1076            (cons 'stats stats))
     1077           snapshot-properties))
     1078         (keys
     1079          (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.
     1080           (cons contents-key contents-reused?))))
    10331081    (if previous
    10341082        (begin
Note: See TracChangeset for help on using the changeset viewer.