Changeset 25521 in project
- Timestamp:
- 11/17/11 12:52:41 (9 years ago)
- Location:
- release/4/ugarit/trunk
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/ugarit/trunk/README.txt
r25506 r25521 799 799 * Everywhere I use (sql ...) to create an sqlite prepared statement, 800 800 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). 802 803 803 804 * Migrate the source repo to Fossil (when there's a … … 815 816 should be an alist which is displayed to the user in a friendly 816 817 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. 817 826 818 827 * Implement "info" admin commands for all backends, that list any … … 892 901 ## Core 893 902 903 * Log all WARNINGs produced during a snapshot job, and attach them to 904 the snapshot object as a text file. 905 894 906 * Clarify what characters are legal in tag names sent to backends, and 895 907 what are legal in human-supplied tag names, and check that … … 1128 1140 # Version history 1129 1141 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--". 1133 1152 1134 1153 * 1.0: Migrated from gdbm to sqlite for metadata storage, removing the -
release/4/ugarit/trunk/VERSION.txt
r25482 r25521 1 1.0 1 1.0.1 -
release/4/ugarit/trunk/backend-cache.scm
r25501 r25521 9 9 (define (backend-cache cachepath be) 10 10 (define *db* (open-database cachepath)) 11 (change-file-mode cachepath (bitwise-ior perm/irusr perm/iwusr)) 11 12 (when (null? (schema *db*)) 12 13 (for-each (lambda (statement) 13 14 (exec (sql *db* statement))) 14 15 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!))) 15 33 16 34 (define (cache-set! key type) 17 35 (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!))) 19 39 type) 20 40 21 41 (define (cache-get key) 22 42 (let ((result 23 (query fetch (sql *db* "SELECT type FROM cache WHERE key = ?")key)))43 (query fetch cache-get-query key))) 24 44 (if (pair? result) 25 45 (string->symbol (car result)) … … 27 47 28 48 (define (cache-delete! key) 29 (exec (sql *db* "DELETE FROM cache WHERE key = ?") key)) 49 (exec cache-delete-query key) 50 (maybe-flush!)) 30 51 31 52 (make-storage … … 54 75 result))) 55 76 (lambda (tag key) ; set-tag! 56 ((storage-set-tag! be) tag key)) 77 ((storage-set-tag! be) tag key) 78 (flush!)) 57 79 (lambda (tag) ; tag 58 80 ((storage-tag be) tag)) … … 60 82 ((storage-all-tags be))) 61 83 (lambda (tag) ; remove-tag! 62 ((storage-remove-tag! be) tag)) 84 ((storage-remove-tag! be) tag) 85 (flush!)) 63 86 (lambda (tag) ; lock-tag! 64 ((storage-lock-tag! be) tag)) 87 ((storage-lock-tag! be) tag) 88 (flush!)) 65 89 (lambda (tag) ; tag-locked? 66 90 ((storage-tag-locked? be) tag)) 67 91 (lambda (tag) ; unlock-tag! 68 ((storage-unlock-tag! be) tag)) 92 ((storage-unlock-tag! be) tag) 93 (flush!)) 69 94 (lambda () ; close! 70 95 ((begin 96 (exec (sql *db* "COMMIT;")) 71 97 (close-database *db*) 72 98 (storage-close! be)))))) -
release/4/ugarit/trunk/backend-fs.scm
r25479 r25521 153 153 "CREATE TABLE metadata (key TEXT PRIMARY KEY, value TEXT);" 154 154 "INSERT INTO metadata VALUES ('version','1');" 155 "INSERT INTO metadata VALUES ('current-logfile','0');"156 155 "CREATE TABLE blocks (key TEXT PRIMARY KEY, type TEXT, fileno INTEGER, position INTEGER, length INTEGER);" 157 156 "CREATE TABLE tags (tag TEXT PRIMARY KEY, key TEXT, locked INTEGER DEFAULT 0);")) … … 161 160 ((*db* 162 161 (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. 163 163 (when (null? (schema db)) 164 164 (for-each (lambda (statement) 165 165 (exec (sql db statement))) 166 166 splitlog-sql-schema)) 167 (exec (sql db "BEGIN;")) 167 168 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"))) 169 195 (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))) 172 197 (*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))) 174 199 (*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 175 223 (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))) 177 225 (if (pair? bd) 178 226 (let ((type (string->symbol (first bd))) … … 182 230 (list type fileno position length)) 183 231 #f)))) 232 184 233 (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 186 237 (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 188 241 (remove-tag! (lambda (tag) 189 (exec (sql *db* "DELETE FROM tags WHERE tag = ?") tag))) 242 (exec remove-tag-query tag) 243 (flush!))) 244 190 245 (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))) 192 247 (if (pair? td) 193 248 (car td) 194 249 #f)))) 250 195 251 (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 197 255 (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))) 199 257 (if (pair? td) 200 258 (car td) 201 259 #f)))) 260 202 261 (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))))) 213 263 214 264 (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? 216 266 #t ; We are writable 217 267 #f ; We DO NOT support unlink! 218 268 219 269 (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))) 240 288 241 289 (lambda (key) ; exists? … … 286 334 (set-tag-lock! tag 0)) 287 335 (lambda () ; close! 336 (flush!) 337 (exec (sql *db* "COMMIT;")) 288 338 (close-database *db*) 289 339 (file-close *log*) -
release/4/ugarit/trunk/ugarit-core.scm
r25501 r25521 260 260 (('file-cache path) 261 261 (set! *file-cache* (open-database path)) 262 (change-file-mode path (bitwise-ior perm/irusr perm/iwusr)) 262 263 (when (null? (schema *file-cache*)) 263 264 (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.