Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -168,11 +168,11 @@ mv deploytarg/deploytarg deploytarg/dboard # DATASHAREO=configf.o common.o process.o tree.o dcommon.o margs.o launch.o gutils.o db.o synchash.o server.o \ # megatest-version.o tdb.o ods.o mt.o keys.o datashare-testing/datashare : datashare.scm $(OFILES) - mkdir -p /tmp/$(USER)/datashare /tmp/$(USER)/datashare/disk1 csc datashare.scm $(OFILES) -o datashare-testing/datashare datashare : datashare-testing/datashare + mkdir -p /tmp/$(USER)/datashare/disk1 /tmp/$(USER)/basepath BASEPATH=/tmp/$(USER)/basepath ./datashare-testing/datashare Index: datashare.scm ================================================================== --- datashare.scm +++ datashare.scm @@ -68,11 +68,11 @@ ;; RECORDS ;;====================================================================== ;; make-vector-record "testing" datastore pkg id area version_name store_type copied source_path iteration submitter datetime storegrp datavol quality disk_id comment ;; testing -(define (make-datastore:pkg)(make-vector 14)) +(define (make-datastore:pkg)(make-vector 15)) (define-inline (datastore:pkg-get-id vec) (vector-ref vec 0)) (define-inline (datastore:pkg-get-area vec) (vector-ref vec 1)) (define-inline (datastore:pkg-get-version_name vec) (vector-ref vec 2)) (define-inline (datastore:pkg-get-store_type vec) (vector-ref vec 3)) (define-inline (datastore:pkg-get-copied vec) (vector-ref vec 4)) @@ -83,10 +83,11 @@ (define-inline (datastore:pkg-get-storegrp vec) (vector-ref vec 9)) (define-inline (datastore:pkg-get-datavol vec) (vector-ref vec 10)) (define-inline (datastore:pkg-get-quality vec) (vector-ref vec 11)) (define-inline (datastore:pkg-get-disk_id vec) (vector-ref vec 12)) (define-inline (datastore:pkg-get-comment vec) (vector-ref vec 13)) +(define-inline (datastore:pkg-get-stored_path vec) (vector-ref vec 14)) (define-inline (datastore:pkg-set-id! vec val)(vector-set! vec 0 val)) (define-inline (datastore:pkg-set-area! vec val)(vector-set! vec 1 val)) (define-inline (datastore:pkg-set-version_name! vec val)(vector-set! vec 2 val)) (define-inline (datastore:pkg-set-store_type! vec val)(vector-set! vec 3 val)) (define-inline (datastore:pkg-set-copied! vec val)(vector-set! vec 4 val)) @@ -97,10 +98,11 @@ (define-inline (datastore:pkg-set-storegrp! vec val)(vector-set! vec 9 val)) (define-inline (datastore:pkg-set-datavol! vec val)(vector-set! vec 10 val)) (define-inline (datastore:pkg-set-quality! vec val)(vector-set! vec 11 val)) (define-inline (datastore:pkg-set-disk_id! vec val)(vector-set! vec 12 val)) (define-inline (datastore:pkg-set-comment! vec val)(vector-set! vec 13 val)) +(define-inline (datastore:pkg-set-stored_path! vec val)(vector-set! vec 14 val)) ;;====================================================================== ;; DB ;;====================================================================== @@ -114,10 +116,11 @@ area TEXT, version_name TEXT, store_type TEXT DEFAULT 'copy', copied INTEGER DEFAULT 0, source_path TEXT, + stored_path TEXT, iteration INTEGER DEFAULT 0, submitter TEXT, datetime TIMESTAMP DEFAULT (strftime('%s','now')), storegrp TEXT, datavol INTEGER, @@ -149,10 +152,26 @@ (sqlite3:execute db "INSERT INTO pkgs (area,version_name,iteration,store_type,submitter,source_path,quality,comment) VALUES (?,?,?,?,?,?,?,?);" area version-name next-iteration (conc store-type) submitter source-path quality comment))) (sqlite3:finalize! iter-qry) next-iteration)) + +(define (datastore:get-id db area version-name iteration) + (let ((res #f)) + (sqlite3:for-each-row + (lambda (id) + (set! res id)) + db + "SELECT id FROM pkgs WHERE area=? AND version_name=? AND iteration=?;" + area version-name iteration) + res)) + +(define (datastore:set-stored-path db id path) + (sqlite3:execute db "UPDATE pkgs SET stored_path=? WHERE id=?;" path id)) + +(define (datastore:set-copied db id value) + (sqlite3:execute db "UPDATE pkgs SET copied=? WHERE id=?;" value id)) (define (datashare:get-pkg-record db area version-name iteration) #f) ;; Create the sqlite db @@ -217,28 +236,48 @@ (let ((res '())) (sqlite3:for-each-row ;; replace with fold ... (lambda (a . b) (set! res (cons (list->vector (cons a b)) res))) db - (conc "SELECT id,area,version_name,store_type,copied,source_path,iteration,submitter,datetime,storegrp,datavol,quality,disk_id,comment " + (conc "SELECT id,area,version_name,store_type,copied,source_path,iteration,submitter,datetime,storegrp,datavol,quality,disk_id,comment,stored_path " " FROM pkgs WHERE area like ? AND version_name LIKE ? AND iteration " iter-filter ";") area-filter version-filter) (reverse res))) ;;====================================================================== ;; 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 (datashare:import-data configdat source-path dest-path area version iteration) + (let* ((space-avail (car dest-path)) + (disk-path (cdr dest-path)) + (targ-path (conc disk-path "/" area "/" version "/" iteration)) + (id (datastore:get-id db area version iteration)) + (db (datashare:open-db configdat))) + (if (> space-avail 10000) ;; dumb heuristic + (begin + (create-directory targ-path #t) + (datastore:set-stored-path db id targ-path) + (print "Running command: rsync -av " source-path " " targ-path) + (let ((th1 (make-thread (lambda () + (let ((pid (process-run "rsync" (list "-av" source-path targ-path)))) + (process-wait pid) + (datastore:set-copied db id "yes") + (sqlite3:finalize! db))) + "Data copy"))) + (thread-start! th1)) + #t) + (begin + (print "ERROR: Not enough space in storage area " dest-path) + (datastore:set-copied db id "no") + (sqlite3:finalize! db) + #f)))) (define (datastore:get-best-storage configdat) - (let* ((storage (configf:lookup configdat "setup" "storage")) + (let* ((storage (configf:lookup configdat "settings" "storage")) (store-areas (if storage (string-split storage) '()))) + (print "Looking for available space in " store-areas) (datastore:find-most-space store-areas))) (define (datastore:find-most-space paths) (fold (lambda (area res) ;; (print "area=" area " res=" res) @@ -312,11 +351,11 @@ (db (datashare:open-db configdat)) (iteration (datashare:register-data db area-name version publish-type submitter quality spath comment)) (dest-store (datastore:get-best-storage configdat))) (if iteration (if (eq? 'copy publish-type) - (datashare:import-data spath dest-store area-name version iteration)) + (datashare:import-data configdat spath dest-store area-name version iteration)) (print "ERROR: Failed to get an iteration number")) (sqlite3:finalize! db)))) (copy (iup:button "Copy and Publish" #:expand "HORIZONTAL" #:action (lambda (obj) @@ -349,25 +388,41 @@ (iup:hbox (iup:label "Source base path:" #:size label-size) source-tb browse-btn) (iup:hbox copy link)))) (define (datastore:lst->path pathlst) (conc "/" (string-intersperse (map conc pathlst) "/"))) + +(define (datastore:path->lst path) + (string-split path "/")) + +(define (datastore:pathdat-apply-heuristics configdat path) + (cond + ((file-exists? path) "found") + (else "not installed"))) (define (datashare:get-view configdat) (iup:vbox (iup:hbox (let* ((label-size "60x") + ;; filter elements (area-filter "%") (version-filter "%") (iter-filter ">= 0") - (dat (make-hash-table)) ;; reverse lookup - (apply (iup:button "Apply")) + ;; reverse lookup from path to data for src and installed + (srcdat (make-hash-table)) ;; reverse lookup + (installed-dat (make-hash-table)) + ;; config values + (basepath (configf:lookup configdat "settings" "basepath")) + ;; gui elements (submitter (iup:label "" #:expand "HORIZONTAL")) (date-submitted (iup:label "" #:expand "HORIZONTAL")) (comment (iup:label "" #:expand "HORIZONTAL")) (copy-link (iup:label "" #:expand "HORIZONTAL")) (quality (iup:label "" #:expand "HORIZONTAL")) + (installed-status (iup:label "" #:expand "HORIZONTAL")) + ;; misc + (curr-record #f) ;; (source-data (iup:label "" #:expand "HORIZONTAL")) (tb (iup:treebox #:value 0 #:name "Packages" #:expand "YES" @@ -374,13 +429,14 @@ #:addexpanded "NO" #:selection-cb (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((path (datastore:lst->path (cdr (tree:node->path obj id)))) - (record (hash-table-ref/default dat path #f))) + (record (hash-table-ref/default srcdat path #f))) (if record (begin + (set! curr-record record) (iup:attribute-set! submitter "TITLE" (datastore:pkg-get-submitter record)) (iup:attribute-set! date-submitted "TITLE" (time->string (seconds->local-time (datastore:pkg-get-datetime record)))) (iup:attribute-set! comment "TITLE" (datastore:pkg-get-comment record)) (iup:attribute-set! quality "TITLE" (datastore:pkg-get-quality record)) (iup:attribute-set! copy-link "TITLE" (datastore:pkg-get-store_type record)) @@ -387,57 +443,82 @@ )) (print "id=" id " path=" path " record=" record);; (tree:node->path obj id) " run-id: " run-id) )))) (tb2 (iup:treebox #:value 0 - #:name "Packages" + #:name "Installed" #:expand "YES" #:addexpanded "NO" #:selection-cb (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((path (datastore:lst->path (cdr (tree:node->path obj id)))) - (record (hash-table-ref/default dat path #f))) - (if record - (begin - (iup:attribute-set! submitter "TITLE" (datastore:pkg-get-submitter record)) - (iup:attribute-set! date-submitted "TITLE" (time->string (seconds->local-time (datastore:pkg-get-datetime record)))) - (iup:attribute-set! comment "TITLE" (datastore:pkg-get-comment record)) - (iup:attribute-set! quality "TITLE" (datastore:pkg-get-quality record)) - (iup:attribute-set! copy-link "TITLE" (datastore:pkg-get-store_type record)) - )) - (print "id=" id " path=" path " record=" record);; (tree:node->path obj id) " run-id: " run-id) + (status (hash-table-ref/default installed-dat path #f))) + (iup:attribute-set! installed-status "TITLE" (if status status "")) )))) (refresh (lambda (obj) - (let ((db (datashare:open-db configdat))) + (let* ((db (datashare:open-db configdat)) + (areas (or (configf:get-section configdat "areas") '()))) + ;; + ;; first update the Sources + ;; (for-each (lambda (pkgitem) (let* ((pkg-path (list (datastore:pkg-get-area pkgitem) (datastore:pkg-get-version_name pkgitem) (datastore:pkg-get-iteration pkgitem))) (pkg-id (datastore:pkg-get-id pkgitem)) (path (datastore:lst->path pkg-path))) ;; (print "tree:add-node tb=" tb ", pkg-path=" pkg-path ", pkg-id=" pkg-id) - (if (not (hash-table-ref/default dat path #f)) + (if (not (hash-table-ref/default srcdat path #f)) (tree:add-node tb "Packages" pkg-path userdata: (conc "pkg-id: " pkg-id))) ;; (print "path=" path " pkgitem=" pkgitem) - (hash-table-set! dat path pkgitem))) + (hash-table-set! srcdat path pkgitem))) (datashare:get-pkgs db area-filter version-filter iter-filter)) - (sqlite3:finalize! db))))) + ;; + ;; then update the installed + ;; + (for-each + (lambda (area) + (let* ((path (conc "/" (cadr area))) + (fullpath (conc basepath path))) + (if (not (hash-table-ref/default installed-dat path #f)) + (tree:add-node tb2 "Installed" (datastore:path->lst path))) + (hash-table-set! installed-dat path (datastore:pathdat-apply-heuristics configdat path)))) + areas) + (sqlite3:finalize! db)))) + (apply (iup:button "Apply" + #:action + (lambda (obj) + (if curr-record + (let* ((stored-path (datastore:pkg-get-stored_path curr-record)) + (source-type (datastore:pkg-get-store_type curr-record)) + (source-path (case source-type ;; (equal? source-type "link")) + ((link)(datastore:pkg-get-source-path curr-record)) + ((copy)stored-path) + (else #f)))) + (print "Creating link from " stored-path " to " basepath))))))) (iup:vbox (iup:hbox tb tb2) - (iup:hbox (iup:button "Refresh" #:action refresh) apply) - (iup:hbox (iup:label "Submitter: ") ;; #:size label-size) - submitter - (iup:label "Submitted on: ") ;; #:size label-size) - date-submitted) - (iup:hbox (iup:label "Data stored: ") - copy-link - (iup:label "Quality: ") - quality) - (iup:hbox (iup:label "Comment: ") - comment) + (iup:frame + #:title "Source Info" + (iup:vbox + (iup:hbox (iup:button "Refresh" #:action refresh) apply) + (iup:hbox (iup:label "Submitter: ") ;; #:size label-size) + submitter + (iup:label "Submitted on: ") ;; #:size label-size) + date-submitted) + (iup:hbox (iup:label "Data stored: ") + copy-link + (iup:label "Quality: ") + quality) + (iup:hbox (iup:label "Comment: ") + comment))) + (iup:frame + #:title "Installed Info" + (iup:vbox + (iup:hbox (iup:label "Installed status/path: ") installed-status))) ))))) (define (datashare:manage-view configdat) (iup:vbox (iup:hbox