Changeset 25521 in project


Ignore:
Timestamp:
11/17/11 12:52:41 (9 years ago)
Author:
Alaric Snell-Pym
Message:

ugarit: Better use of sqlite, which will hopefully improve performance. 1.0.1 release.

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

Legend:

Unmodified
Added
Removed

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

    r25506 r25521  
    799799* Everywhere I use (sql ...) to create an sqlite prepared statement,
    800800  don't. Create them all up-front and reuse the resulting statement
    801   objects, it'll save memory and time.
     801  objects, it'll save memory and time. (done for backend-fs/splitlog
     802  and backend/cache, file-cache still needs it).
    802803
    803804* Migrate the source repo to Fossil (when there's a
    … …  
    815816  should be an alist which is displayed to the user in a friendly
    816817  manner, as "Key: Value\n" lines.
     818
     819* Extend the backend protocol with a `flush` command, such that
     820  operations performed without a subsequent `flush` might not "stick" in
     821  failure cases (make `close!` have an implicit `flush`, of
     822  course). Then use this to let splitlog and cache backends buffer
     823  sqlite `INSERT`s and then spit them out in a single transaction per
     824  `flush`/`close` or when the buffer hits a determined size limit, to
     825  improve throughput.
    817826
    818827* Implement "info" admin commands for all backends, that list any
    … …  
    892901## Core
    893902
     903* Log all WARNINGs produced during a snapshot job, and attach them to
     904  the snapshot object as a text file.
     905
    894906* Clarify what characters are legal in tag names sent to backends, and
    895907  what are legal in human-supplied tag names, and check that
    … …  
    11281140# Version history
    11291141
    1130 * 1.1: Consistency check on read blocks by default. Removed warning
    1131   about deletions from backend-cache; we need a new mechanism to report
    1132   warnings from backends.
     1142* 1.0.1: Consistency check on read blocks by default. Removed warning
     1143  about deletions from backend-cache; we need a new mechanism to
     1144  report warnings from backends to the user. Made backend-cache and
     1145  backend-fs/splitlog commit periodically rather than after every
     1146  insert, which should speed up snapshotting a lot, and reused the
     1147  prepared statements rather than re-preparing them all the
     1148  time. BUGFIX: splitlog backend now creates log files with
     1149  "rw-------" rather than "rwx------" permissions; and all sqlite
     1150  databases (splitlog metadata, cache file, and file-cache file) are
     1151  created with "rw-------" rather then "rw-r--r--".
    11331152
    11341153* 1.0: Migrated from gdbm to sqlite for metadata storage, removing the

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

    r25482 r25521  
    1 1.0
     11.0.1

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

    r25501 r25521  
    99(define (backend-cache cachepath be)
    1010   (define *db* (open-database cachepath))
     11   (change-file-mode cachepath (bitwise-ior perm/irusr perm/iwusr))
    1112   (when (null? (schema *db*))
    1213         (for-each (lambda (statement)
    1314                     (exec (sql *db* statement)))
    1415                   cache-sql-schema))
     16   (exec (sql *db* "BEGIN;"))
     17
     18   (define cache-set-query (sql *db* "INSERT OR REPLACE INTO cache (key, type) VALUES (?,?)"))
     19   (define cache-get-query (sql *db* "SELECT type FROM cache WHERE key = ?"))
     20   (define cache-delete-query (sql *db* "DELETE FROM cache WHERE key = ?"))
     21
     22   (define commit-interval 1000)
     23   (define *updates-since-last-commit* 0)
     24   (define (flush!)
     25     (exec (sql *db* "COMMIT;"))
     26     (exec (sql *db* "BEGIN;"))
     27     (set! *updates-since-last-commit* 0))
     28   (define (maybe-flush!)
     29     (set! *updates-since-last-commit*
     30           (+ *updates-since-last-commit* 1))
     31     (when (> *updates-since-last-commit* commit-interval)
     32           (flush!)))
    1533
    1634   (define (cache-set! key type)
    1735      (when type
    18           (exec (sql *db* "INSERT OR REPLACE INTO cache (key, type) VALUES (?,?)") key (symbol->string type)))
     36            (begin
     37              (exec cache-set-query key (symbol->string type))
     38              (maybe-flush!)))
    1939      type)
    2040
    2141   (define (cache-get key)
    2242      (let ((result
    23              (query fetch (sql *db* "SELECT type FROM cache WHERE key = ?") key)))
     43             (query fetch cache-get-query key)))
    2444        (if (pair? result)
    2545            (string->symbol (car result))
    … …  
    2747
    2848   (define (cache-delete! key)
    29      (exec (sql *db* "DELETE FROM cache WHERE key = ?") key))
     49     (exec cache-delete-query key)
     50     (maybe-flush!))
    3051
    3152   (make-storage
    … …  
    5475               result)))
    5576      (lambda (tag key) ; set-tag!
    56          ((storage-set-tag! be) tag key))
     77        ((storage-set-tag! be) tag key)
     78        (flush!))
    5779      (lambda (tag) ; tag
    5880         ((storage-tag be) tag))
    … …  
    6082         ((storage-all-tags be)))
    6183      (lambda (tag) ; remove-tag!
    62          ((storage-remove-tag! be) tag))
     84         ((storage-remove-tag! be) tag)
     85         (flush!))
    6386      (lambda (tag) ; lock-tag!
    64          ((storage-lock-tag! be) tag))
     87         ((storage-lock-tag! be) tag)
     88         (flush!))
    6589      (lambda (tag) ; tag-locked?
    6690         ((storage-tag-locked? be) tag))
    6791      (lambda (tag) ; unlock-tag!
    68          ((storage-unlock-tag! be) tag))
     92         ((storage-unlock-tag! be) tag)
     93         (flush!))
    6994      (lambda () ; close!
    7095         ((begin
     96            (exec (sql *db* "COMMIT;"))
    7197            (close-database *db*)
    7298            (storage-close! be))))))

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

    r25479 r25521  
    153153   "CREATE TABLE metadata (key TEXT PRIMARY KEY, value TEXT);"
    154154   "INSERT INTO metadata VALUES ('version','1');"
    155    "INSERT INTO metadata VALUES ('current-logfile','0');"
    156155   "CREATE TABLE blocks (key TEXT PRIMARY KEY, type TEXT, fileno INTEGER, position INTEGER, length INTEGER);"
    157156   "CREATE TABLE tags (tag TEXT PRIMARY KEY, key TEXT, locked INTEGER DEFAULT 0);"))
    … …  
    161160        ((*db*
    162161          (let ((db (open-database metapath)))
     162            (change-file-mode metapath (bitwise-ior perm/irusr perm/iwusr)) ; Don't think we can do anything about the journal files, though.
    163163            (when (null? (schema db))
    164164                  (for-each (lambda (statement)
    165165                              (exec (sql db statement)))
    166166                            splitlog-sql-schema))
     167            (exec (sql db "BEGIN;"))
    167168            db))
    168          (*logcount* (string->number (car (query fetch (sql *db* "SELECT value FROM metadata WHERE key = 'current-logfile'")))))
     169
     170         ; Prepared statements
     171         (get-metadata-query (sql *db* "SELECT value FROM metadata WHERE key = ?"))
     172         (set-metadata-query (sql *db* "INSERT OR REPLACE INTO metadata (key,value) VALUES (?,?)"))
     173         (get-block-data-query (sql *db* "SELECT type, fileno, position, length FROM blocks WHERE key = ?"))
     174         (set-block-data-query (sql *db* "INSERT INTO blocks (key,type,fileno,position,length) VALUES (?,?,?,?,?)"))
     175         (get-tag-query (sql *db* "SELECT key FROM tags WHERE tag = ?"))
     176         (set-tag-query (sql *db* "INSERT OR REPLACE INTO tags (tag,key) VALUES (?,?)"))
     177         (remove-tag-query (sql *db* "DELETE FROM tags WHERE tag = ?"))
     178         (set-tag-lock-query (sql *db* "UPDATE tags SET locked = ? WHERE tag = ?"))
     179         (get-tag-lock-query (sql *db* "SELECT locked FROM tags WHERE tag = ?"))
     180         (get-tags-query (sql *db* "SELECT tag FROM tags"))
     181
     182         ; Database access functions
     183         (get-metadata (lambda (key default)
     184                         (let ((result (query fetch get-metadata-query key)))
     185                           (if (null? result)
     186                               (begin
     187                                 (exec set-metadata-query key default)
     188                                 default)
     189                               (car result)))))
     190         (set-metadata (lambda (key value)
     191                         (exec set-metadata-query key value)))
     192
     193         ; Log file management
     194         (*logcount* (string->number (get-metadata "current-logfile" "0")))
    169195         (set-logcount! (lambda (newcount)
    170                          (set! *logcount* newcount)
    171                          (exec (sql *db* "INSERT OR REPLACE INTO metadata (key,value) VALUES ('current-logfile',?)") newcount)))
     196                         (set! *logcount* newcount)))
    172197         (*log* (file-open (string-append logdir "/log" (number->string *logcount*))
    173                   (+ open/creat open/rdwr open/append) perm/irwxu))
     198                  (bitwise-ior open/creat open/rdwr open/append) (bitwise-ior perm/irusr perm/iwusr)))
    174199         (*logfiles* (make-hash-table)) ; hash of file number to FD
     200         (get-log (lambda (index)
     201            (if (hash-table-exists? *logfiles* index)
     202               (hash-table-ref *logfiles* index)
     203               (begin
     204                  (let ((fd (file-open (string-append logdir "/log" (number->string index)) open/rdonly perm/irwxu)))
     205                     (set! (hash-table-ref *logfiles* index) fd)
     206                     fd)))))
     207
     208         ; Periodic commit management
     209         (commit-interval (string->number (get-metadata "commit-interval" "1000")))
     210         (*updates-since-last-commit* 0)
     211         (flush! (lambda ()
     212                   (set-metadata "current-logfile" (number->string *logcount*))
     213                   (exec (sql *db* "COMMIT;"))
     214                   (exec (sql *db* "BEGIN;"))
     215                   (set! *updates-since-last-commit* 0)))
     216         (maybe-flush! (lambda ()
     217                         (set! *updates-since-last-commit*
     218                               (+ *updates-since-last-commit* 1))
     219                         (when (> *updates-since-last-commit* commit-interval)
     220                             (flush!))))
     221
     222         ; Higher-level database utilities
    175223         (get-block-data (lambda (key) ; Returns #f for nonexistant blocks
    176                            (let ((bd (query fetch (sql *db* "SELECT type, fileno, position, length FROM blocks WHERE key = ?") key)))
     224                           (let ((bd (query fetch get-block-data-query key)))
    177225                             (if (pair? bd)
    178226                                 (let ((type (string->symbol (first bd)))
    … …  
    182230                                   (list type fileno position length))
    183231                                 #f))))
     232
    184233         (set-block-data! (lambda (key type fileno position length)
    185                            (exec (sql *db* "INSERT INTO blocks (key,type,fileno,position,length) VALUES (?,?,?,?,?)") key (symbol->string type) fileno position length)))
     234                           (exec set-block-data-query key (symbol->string type) fileno position length)
     235                           (maybe-flush!)))
     236
    186237         (set-tag! (lambda (tag key)
    187                     (exec (sql *db* "INSERT OR REPLACE INTO tags (tag,key) VALUES (?,?)") tag key)))
     238                    (exec set-tag-query tag key)
     239                    (flush!)))
     240
    188241         (remove-tag! (lambda (tag)
    189                         (exec (sql *db* "DELETE FROM tags WHERE tag = ?") tag)))
     242                        (exec remove-tag-query tag)
     243                        (flush!)))
     244
    190245         (get-tag (lambda (tag)
    191                          (let ((td (query fetch (sql *db* "SELECT key FROM tags WHERE tag = ?") tag)))
     246                         (let ((td (query fetch get-tag-query tag)))
    192247                           (if (pair? td)
    193248                               (car td)
    194249                               #f))))
     250
    195251         (set-tag-lock! (lambda (tag lock)
    196                       (exec (sql *db* "UPDATE tags SET locked = ? WHERE tag = ?") lock tag)))
     252                      (exec set-tag-lock-query lock tag)
     253                      (flush!)))
     254
    197255         (get-tag-lock (lambda (tag lock)
    198                          (let ((td (query fetch (sql *db* "SELECT locked FROM tags WHERE tag = ?") tag)))
     256                         (let ((td (query fetch get-tag-lock-query tag)))
    199257                           (if (pair? td)
    200258                               (car td)
    201259                               #f))))
     260
    202261         (get-tags (lambda ()
    203                      (map car (query fetch-all (sql *db* "SELECT tag FROM tags")))))
    204          (get-log (lambda (index)
    205             (if (hash-table-exists? *logfiles* index)
    206                (hash-table-ref *logfiles* index)
    207                (begin
    208                   (let ((fd (file-open (string-append logdir "/log" (number->string index)) open/rdonly perm/irwxu)))
    209                      (set! (hash-table-ref *logfiles* index) fd)
    210                      fd))))))
    211 
    212       ; FIXME: Sanity check that all opened OK
     262                     (map car (query fetch-all get-tags-query)))))
    213263
    214264      (make-storage
    215          (* 1024 1024) ; 1MiB blocks since local disk is fast and cheap
     265         (* 1024 1024) ; 1MiB blocks since local disk is fast and cheap, right?
    216266         #t ; We are writable
    217267         #f ; We DO NOT support unlink!
    218268
    219269         (lambda (key data type) ; put!
    220            (with-transaction *db*
    221                              (lambda ()
    222                                (when (pair? (get-block-data key))
    223                                      (signal (make-property-condition 'exn 'message "Duplicate block: put! should not be called on an existing hash" 'arguments (list key type))))
    224 
    225                                (set-file-position! *log* 0 seek/end)
    226 
    227                                (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
    228                                      (posn (file-position *log*)))
    229                                  (if (> posn max-logpart-size)
    230                                      (begin
    231                                        (file-close *log*)
    232                                        (set! posn 0)
    233                                        (set-logcount! (+ *logcount* 1))
    234                                        (set! *log* (file-open (string-append logdir "/log" (number->string *logcount*))
    235                                                               (+ open/creat open/rdwr open/append) perm/irwxu))))
    236                                  (file-write *log* header)
    237                                  (file-write *log* (u8vector->blob/shared data))
    238                                  (set-block-data! key type *logcount* (+ (string-length header) posn) (u8vector-length data))
    239                                  (void)))))
     270           (when (pair? (get-block-data key))
     271                 (signal (make-property-condition 'exn 'message "Duplicate block: put! should not be called on an existing hash" 'arguments (list key type))))
     272
     273           (set-file-position! *log* 0 seek/end)
     274
     275           (let ((header (sprintf "(block ~S ~S ~S)" key type (u8vector-length data)))
     276                 (posn (file-position *log*)))
     277             (if (> posn max-logpart-size)
     278                 (begin
     279                   (file-close *log*)
     280                   (set! posn 0)
     281                   (set-logcount! (+ *logcount* 1))
     282                   (set! *log* (file-open (string-append logdir "/log" (number->string *logcount*))
     283                                          (bitwise-ior open/creat open/rdwr open/append) (bitwise-ior perm/irusr perm/iwusr)))))
     284             (file-write *log* header)
     285             (file-write *log* (u8vector->blob/shared data))
     286             (set-block-data! key type *logcount* (+ (string-length header) posn) (u8vector-length data))
     287             (void)))
    240288
    241289         (lambda (key) ; exists?
    … …  
    286334           (set-tag-lock! tag 0))
    287335         (lambda () ; close!
     336           (flush!)
     337           (exec (sql *db* "COMMIT;"))
    288338           (close-database *db*)
    289339           (file-close *log*)

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

    r25501 r25521  
    260260                       (('file-cache path)
    261261                        (set! *file-cache* (open-database path))
     262                        (change-file-mode path (bitwise-ior perm/irusr perm/iwusr))
    262263                        (when (null? (schema *file-cache*))
    263264                              (exec (sql *file-cache* "CREATE TABLE files (path TEXT PRIMARY KEY, mtime INTEGER, size INTEGER, key TEXT);"))))
Note: See TracChangeset for help on using the changeset viewer.