Index: client.scm
==================================================================
--- client.scm
+++ client.scm
@@ -54,11 +54,11 @@
;; client:setup
;;
;; lookup_server, need to remove *runremote* stuff
;;
(define (client:setup run-id #!key (remaining-tries 100) (failed-connects 0))
- (debug:print-info 0 "client:setup remaining-tries=" remaining-tries)
+ (debug:print-info 2 "client:setup remaining-tries=" remaining-tries)
(if (<= remaining-tries 0)
(begin
(debug:print 0 "ERROR: failed to start or connect to server for run-id " run-id)
(exit 1))
(let ((host-info (hash-table-ref/default *runremote* run-id #f)))
@@ -67,37 +67,37 @@
(port (http-transport:server-dat-get-port host-info))
(start-res (http-transport:client-connect iface port))
(ping-res (rmt:login-no-auto-client-setup start-res run-id)))
(if ping-res ;; sucessful login?
(begin
- (debug:print-info 0 "client:setup, ping is good using host-info=" host-info ", remaining-tries=" remaining-tries)
+ (debug:print-info 2 "client:setup, ping is good using host-info=" host-info ", remaining-tries=" remaining-tries)
;; Why add the close-connections here?
;; (http-transport:close-connections run-id)
(hash-table-set! *runremote* run-id start-res)
start-res) ;; return the server info
;; have host info but no ping. shutdown the current connection and try again
(begin ;; login failed
- (debug:print-info 0 "client:setup, ping is bad for start-res=" start-res " and *runremote*=" host-info)
+ (debug:print-info 1 "client:setup, ping is bad for start-res=" start-res " and *runremote*=" host-info)
(http-transport:close-connections run-id)
(hash-table-delete! *runremote* run-id)
(if (< remaining-tries 8)
(thread-sleep! 5)
(thread-sleep! 1))
(client:setup run-id remaining-tries: (- remaining-tries 1)))))
;; YUK: rename server-dat here
(let* ((server-dat (open-run-close tasks:get-server tasks:open-db run-id)))
- (debug:print-info 0 "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
+ (debug:print-info 4 "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
(if server-dat
(let* ((iface (tasks:hostinfo-get-interface server-dat))
(port (tasks:hostinfo-get-port server-dat))
(start-res (http-transport:client-connect iface port))
(ping-res (rmt:login-no-auto-client-setup start-res run-id)))
(if (and start-res
ping-res)
(begin
(hash-table-set! *runremote* run-id start-res)
- (debug:print-info 0 "connected to " (http-transport:server-dat-make-url start-res))
+ (debug:print-info 2 "connected to " (http-transport:server-dat-make-url start-res))
start-res)
(begin ;; login failed but have a server record, clean out the record and try again
(debug:print-info 0 "client:setup, login failed, will attempt to start server ... start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
(http-transport:close-connections run-id)
(hash-table-delete! *runremote* run-id)
Index: datashare-testing/.datashare.config
==================================================================
--- datashare-testing/.datashare.config
+++ datashare-testing/.datashare.config
@@ -1,19 +1,22 @@
# Read in the users vars first (so the offical data cannot be overridden
[include datastore.config]
-[storagegroups]
-1 eng /tmp/datastore/eng
+[storage]
+1 /tmp/datastore/eng
[areas]
-synthesis asic/synthesis
-verilog asic/verilog
-oalibs custom/oalibs
+synthesis asic/synthesis
+verilog asic/verilog
+customlibs custom/oalibs
[target]
basepath #{getenv BASEPATH}
[quality]
0 untested
1 lightly tested
2 tested
3 full QA
+
+[database]
+location /tmp/datastore
Index: datashare.scm
==================================================================
--- datashare.scm
+++ datashare.scm
@@ -62,51 +62,128 @@
(for-each
(lambda (qry)
(sqlite3:execute db qry))
(list
"CREATE TABLE pkgs
- (id INTEGER PRIMARY KEY,
- area TEXT,
- key TEXT,
- iteration INTEGER,
- submitter TEXT,
- datetime TEXT,
- storegrp TEXT,
- datavol INTEGER,
- quality TEXT,
- disk_id INTEGER,
- comment TEXT);"
+ (id INTEGER PRIMARY KEY,
+ area TEXT,
+ version_name TEXT,
+ store_type TEXT DEFAULT 'copy',
+ copied INTEGER DEFAULT 0,
+ source_path TEXT,
+ iteration INTEGER DEFAULT 0,
+ submitter TEXT,
+ datetime TIMESTAMP DEFAULT (strftime('%s','now')),
+ storegrp TEXT,
+ datavol INTEGER,
+ quality TEXT,
+ disk_id INTEGER,
+ comment TEXT);"
"CREATE TABLE refs
(id INTEGER PRIMARY KEY,
pkg_id INTEGER,
destlink TEXT);"
"CREATE TABLE disks
(id INTEGER PRIMARY KEY,
storegrp TEXT,
path TEXT);")))
+
+(define (datashare:register-data db area version-name store-type submitter quality source-path comment)
+ (let ((iter-qry (sqlite3:prepare db "SELECT max(iteration) FROM pkgs WHERE area=? AND version_name=?;"))
+ (next-iteration 0))
+ (sqlite3:with-transaction
+ db
+ (lambda ()
+ (sqlite3:for-each-row
+ (lambda (iteration)
+ (if (and (number? iteration)
+ (>= iteration next-iteration))
+ (set! next-iteration (+ iteration 1))))
+ iter-qry area version-name)
+ ;; now store the data
+ (sqlite3:execute db "INSERT INTO pkgs (area,version_name,iteration,store_type,submitter,source_path,quality,comment)
+ VALUES (?,?,?,?,?,?,?,?);"
+ area version-name next-iteration store-type submitter source-path quality comment)))
+ (sqlite3:finalize! iter-qry)
+ next-iteration))
+
+(define (datashare:get-pkg-record db area version-name iteration)
+ #f)
;; Create the sqlite db
-(define (datashare:open-db path)
- (if (and path
- (directory? path)
- (file-read-access? path))
- (let* ((dbpath (conc path "/datashare.db"))
- (writeable (file-write-access? dbpath))
- (dbexists (file-exists? dbpath))
- (handler (make-busy-timeout 136000)))
- (handle-exceptions
- exn
- (begin
- (debug:print 2 "ERROR: problem accessing db " dbpath
- ((condition-property-accessor 'exn 'message) exn))
- (exit))
- (set! db (sqlite3:open-database dbpath)))
- (if *db-write-access* (sqlite3:set-busy-handler! db handler))
- (if (not dbexists)
- (begin
- (datashare:initialize-db db)))
- db)))
+(define (datashare:open-db configdat)
+ (let ((path (configf:lookup configdat "database" "location")))
+ (if (and path
+ (directory? path)
+ (file-read-access? path))
+ (let* ((dbpath (conc path "/datashare.db"))
+ (writeable (file-write-access? dbpath))
+ (dbexists (file-exists? dbpath))
+ (handler (make-busy-timeout 136000)))
+ (handle-exceptions
+ exn
+ (begin
+ (debug:print 2 "ERROR: problem accessing db " dbpath
+ ((condition-property-accessor 'exn 'message) exn))
+ (exit))
+ (set! db (sqlite3:open-database dbpath)))
+ (if *db-write-access* (sqlite3:set-busy-handler! db handler))
+ (if (not dbexists)
+ (begin
+ (datashare:initialize-db db)))
+ db)
+ (print "ERROR: invalid path for storing database: " path))))
+
+(define (open-run-close-exception-handling proc idb . params)
+ (handle-exceptions
+ exn
+ (let ((sleep-time (random 30))
+ (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
+ (case err-status
+ ((busy)
+ (thread-sleep! sleep-time))
+ (else
+ (print "EXCEPTION: database overloaded or unreadable.")
+ (print " message: " ((condition-property-accessor 'exn 'message) exn))
+ (print "exn=" (condition->list exn))
+ (print " status: " ((condition-property-accessor 'sqlite3 'status) exn))
+ (print-call-chain)
+ (thread-sleep! sleep-time)
+ (print "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")))
+ (apply open-run-close-exception-handling proc idb params))
+ (apply open-run-close-no-exception-handling proc idb params)))
+
+(define (open-run-close-no-exception-handling proc idb . params)
+ ;; (print "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
+ (let* ((db (cond
+ ((sqlite3:database? idb) idb)
+ ((not idb) (print "ERROR: cannot open-run-close with #f anymore"))
+ ((procedure? idb) (idb))
+ (else (print "ERROR: cannot open-run-close with #f anymore"))))
+ (res #f))
+ (set! res (apply proc db params))
+ (if (not idb)(sqlite3:finalize! dbstruct))
+ ;; (print "open-run-close-no-exception-handling END" )
+ res))
+
+(define open-run-close open-run-close-no-exception-handling)
+
+;;======================================================================
+;; DATA IMPORT/EXPORT
+;;======================================================================
+
+(define (datashare:import-data source-path dest-path area version iteration)
+ (let ((targ-path (conc dest-path "/" area "/" version "/" iteration)))
+ (create-directory targ-path #t)
+ (process-run "rsync" (list "-av" source-path targ-path))
+ #t)) ;; #t on success
+
+(define (datastore:get-best-storage configdat)
+ (let ((store-areas (configf:get-section configdat "storage")))
+ (print "store-areas:")
+ (pp store-areas)
+ (cadar store-areas)))
;;======================================================================
;; GUI
;;======================================================================
@@ -134,24 +211,39 @@
(pp (hash-table->alist configdat))
(let* ((areas (configf:get-section configdat "areas"))
(label-size "70x")
(areas-sel (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES"))
(version-tb (iup:textbox #:expand "HORIZONTAL")) ;; #:size "50x"))
+ (areas-sel (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES"))
+ (component (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES" ))
+ (version-val (iup:textbox #:expand "HORIZONTAL" #:size "50x"))
+ ;; (iteration (iup:textbox #:expand "YES" #:size "20x"))
;; (iteration (iup:textbox #:expand "HORIZONTAL" #:size "20x"))
(comment-tb (iup:textbox #:expand "YES" #:multiline "YES"))
+ (import-type "copy")
(source-tb (iup:textbox #:expand "HORIZONTAL"
#:value (or (configf:lookup configdat "target" "basepath")
"")))
(publish (lambda (publish-type)
- (let* ((area-num (or (string->number (iup:attribute areas-sel "VALUE")) 0))
- (area-dat (if (> area-num 0)(list-ref areas (- area-num 1))'("NOT SELECTED" "NOT SELECTED")))
- (area-path (cadr area-dat))
- (area-name (car area-dat))
- (version (iup:attribute version-tb "VALUE"))
- (comment (iup:attribute comment-tb "VALUE"))
- (spath (iup:attribute source-tb "VALUE")))
- (print "Publish: type=" publish-type ", area-name=" area-name ", spath=" spath ", area-path=" area-path ))))
+ (let* ((area-num (or (string->number (iup:attribute areas-sel "VALUE")) 0))
+ (area-dat (if (> area-num 0)(list-ref areas (- area-num 1))'("NOT SELECTED" "NOT SELECTED")))
+ (area-path (cadr area-dat))
+ (area-name (car area-dat))
+ (version (iup:attribute version-tb "VALUE"))
+ (comment (iup:attribute comment-tb "VALUE"))
+ (spath (iup:attribute source-tb "VALUE"))
+ (submitter (current-user-name))
+ (quality 2)
+ (db (datashare:open-db configdat))
+ (iteration (datashare:register-data db area-name version import-type submitter quality spath comment))
+ (dest-store (datastore:get-best-storage configdat)))
+ (if iteration
+ (if (equal? "copy" import-type)
+ (datashare:import-data spath dest-store area-name version iteration))
+ (print "ERROR: Failed to get an iteration number"))
+ (sqlite3:finalize! db))))
+ ;; (print "Publish: type=" publish-type ", area-name=" area-name ", spath=" spath ", area-path=" area-path ))))
(copy (iup:button "Copy and Publish"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(publish 'copy))))
(link (iup:button "Link and Publish"
@@ -218,11 +310,12 @@
;;======================================================================
;; MAIN
;;======================================================================
(define (datashare:load-config path)
- (let ((fname (conc path "/.datashare.config")))
+ (let* ((exename (pathname-file (car (argv))))
+ (fname (conc path "/." exename ".config")))
(ini:property-separator-patt " * *")
(ini:property-separator #\space)
(if (file-exists? fname)
;; (ini:read-ini fname)
(read-config fname #f #t)