Index: datashare.scm
==================================================================
--- datashare.scm
+++ datashare.scm
@@ -14,812 +14,811 @@
 ;;     GNU General Public License for more details.
 ;; 
 ;;     You should have received a copy of the GNU General Public License
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
-(use ssax)
-(use sxml-serializer)
-(use sxml-modifications)
-(use regex)
-(use srfi-69)
-(use regex-case)
-(use posix)
-(use json)
-(use csv)
-(use srfi-18)
-(use format)
-
-(require-library iup)
-(import (prefix iup iup:))
-(require-library ini-file)
-(import (prefix ini-file ini:))
-
-(use canvas-draw)
-(import canvas-draw-iup)
-
-(use sqlite3 srfi-1 posix regex regex-case srfi-69)
-(import (prefix sqlite3 sqlite3:))
-
-(declare (uses configf))
-(declare (uses tree))
-(declare (uses margs))
-;; (declare (uses dcommon))
-;; (declare (uses launch))
-;; (declare (uses gutils))
-;; (declare (uses db))
-;; (declare (uses synchash))
-;; (declare (uses server))
-;; (declare (uses megatest-version))
-;; (declare (uses tbd))
-
-(include "megatest-fossil-hash.scm")
-
-;;
-;; GLOBALS
-;;
-(define *datashare:current-tab-number* 0)
-(define *args-hash* (make-hash-table))
-(define datashare:help (conc "Usage: datashare [action [params ...]]
-
-Note: run datashare without parameters to start the gui.
-
-  list-areas                          : List the allowed areas
-
-  list-versions <area>                : List versions available in <area>
-         options : -full, -vpatt patt
-
-  publish <path> <area> <version>     : Publish data for area and with version
-
-  get <area> <version>                : Get a link to data, put the link in destpath
-         options : -i iteration
-
-  update <area>                       : Update the link to data to the latest iteration.
-
-Part of the Megatest tool suite.
-Learn more at http://www.kiatoa.com/fossils/megatest
-
-Version: " megatest-fossil-hash)) ;; "
-
-;;======================================================================
-;; 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-datashare:pkg)(make-vector 15))
-(define-inline (datashare:pkg-get-id             vec)    (vector-ref  vec 0))
-(define-inline (datashare:pkg-get-area           vec)    (vector-ref  vec 1))
-(define-inline (datashare:pkg-get-version_name   vec)    (vector-ref  vec 2))
-(define-inline (datashare:pkg-get-store_type     vec)    (vector-ref  vec 3))
-(define-inline (datashare:pkg-get-copied         vec)    (vector-ref  vec 4))
-(define-inline (datashare:pkg-get-source_path    vec)    (vector-ref  vec 5))
-(define-inline (datashare:pkg-get-iteration      vec)    (vector-ref  vec 6))
-(define-inline (datashare:pkg-get-submitter      vec)    (vector-ref  vec 7))
-(define-inline (datashare:pkg-get-datetime       vec)    (vector-ref  vec 8))
-(define-inline (datashare:pkg-get-storegrp       vec)    (vector-ref  vec 9))
-(define-inline (datashare:pkg-get-datavol        vec)    (vector-ref  vec 10))
-(define-inline (datashare:pkg-get-quality        vec)    (vector-ref  vec 11))
-(define-inline (datashare:pkg-get-disk_id        vec)    (vector-ref  vec 12))
-(define-inline (datashare:pkg-get-comment        vec)    (vector-ref  vec 13))
-(define-inline (datashare:pkg-get-stored_path    vec)    (vector-ref  vec 14))
-(define-inline (datashare:pkg-set-id!            vec val)(vector-set! vec 0 val))
-(define-inline (datashare:pkg-set-area!          vec val)(vector-set! vec 1 val))
-(define-inline (datashare:pkg-set-version_name!  vec val)(vector-set! vec 2 val))
-(define-inline (datashare:pkg-set-store_type!    vec val)(vector-set! vec 3 val))
-(define-inline (datashare:pkg-set-copied!        vec val)(vector-set! vec 4 val))
-(define-inline (datashare:pkg-set-source_path!   vec val)(vector-set! vec 5 val))
-(define-inline (datashare:pkg-set-iteration!     vec val)(vector-set! vec 6 val))
-(define-inline (datashare:pkg-set-submitter!     vec val)(vector-set! vec 7 val))
-(define-inline (datashare:pkg-set-datetime!      vec val)(vector-set! vec 8 val))
-(define-inline (datashare:pkg-set-storegrp!      vec val)(vector-set! vec 9 val))
-(define-inline (datashare:pkg-set-datavol!       vec val)(vector-set! vec 10 val))
-(define-inline (datashare:pkg-set-quality!       vec val)(vector-set! vec 11 val))
-(define-inline (datashare:pkg-set-disk_id!       vec val)(vector-set! vec 12 val))
-(define-inline (datashare:pkg-set-comment!       vec val)(vector-set! vec 13 val))
-(define-inline (datashare:pkg-set-stored_path!   vec val)(vector-set! vec 14 val))
-
-;;======================================================================
-;; DB
-;;======================================================================
-
-(define (datashare:initialize-db db)
-  (for-each
-   (lambda (qry)
-     (sqlite3:execute db qry))
-   (list 
-    "CREATE TABLE pkgs 
-         (id           INTEGER PRIMARY KEY,
-          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,
-          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 (conc store-type) submitter source-path quality comment)))
-    (sqlite3:finalize! iter-qry)
-    next-iteration))
-
-(define (datashare: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 (datashare:set-stored-path db id path)
-  (sqlite3:execute db "UPDATE pkgs SET stored_path=? WHERE id=?;" path id))
-
-(define (datashare: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)
-  (let ((res #f))
-    (sqlite3:for-each-row
-     (lambda (a . b)
-       (set! res (apply vector a b)))
-     db 
-     "SELECT * FROM pkgs WHERE area=? AND version_name=? AND iteration=?;"
-     area 
-     version-name
-     iteration)
-    res))
-
-;; take version-name iteration and register or update "lastest/0"
-;;
-(define (datashare:set-latest db id area version-name iteration)
-  (let* ((rec         (datashare:get-pkg-record db area version-name iteration))
-	 (latest-id   (datashare:get-id db area "latest" 0))
-	 (stored-path (datashare:pkg-get-stored_path rec)))
-    (if latest-id ;; have a record - bump the link pointer
-	(datashare:set-stored-path db latest-id stored-path)
-	(datashare:register-data db area "latest" 'link "auto" "na" stored-path "latest data"))))
-
-;; set a package ref, this is the location where the link back to the stored data 
-;; is put. 
-;;
-;; if there is nothing at that location then the record can be removed
-;; if there are no refs for a particular pkg-id then that pkg-id is a 
-;; candidate for removal
-;;
-(define (datashare:record-pkg-ref db pkg-id dest-link)
-  (sqlite3:execute db "INSERT INTO refs (pkg_id,destlink) VALUES (?,?);" pkg-id dest-link))
-  
-(define (datashare:count-refs db pkg-id)
-  (let ((res 0))
-    (sqlite3:for-each-row
-     (lambda (count)
-       (set! res count))
-     db
-     "SELECT count(id) FROM refs WHERE pkg_id=?;"
-     pkg-id)
-    res))
-
-;; Create the sqlite 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  (common:file-exists? dbpath))
-	       (handler   (make-busy-timeout 136000)))
-	  (handle-exceptions
-	   exn
-	   (begin
-	     (debug:print 2 *default-log-port* "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 (current-error-port))
-        (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)
-
-(define (datashare:get-pkgs db area-filter version-filter iter-filter)
-  (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,stored_path "
-	   " FROM pkgs WHERE area like ? AND version_name LIKE ? AND iteration " iter-filter ";")
-     area-filter version-filter)
-    (reverse res)))
-
-(define (datashare:get-pkg db area-name version-name #!key (iteration #f))
-  (let ((dat '())
-	(res #f))
-    (sqlite3:for-each-row ;; replace with fold ...
-     (lambda (a . b)
-       (set! dat (cons (list->vector (cons a b)) dat)))
-     db 
-     (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=? AND version_name=? ORDER BY iteration ASC;")
-     area-name version-name)
-    ;; now filter for iteration, either max if #f or specific one
-    (if (null? dat)
-	#f
-	(let loop ((hed (car dat))
-		   (tal (cdr dat))
-		   (cur 0))
-	  (let ((itr (datashare:pkg-get-iteration hed)))
-	    (if (equal? itr iteration) ;; this is the one if iteration is specified
-		hed
-		(if (null? tal)
-		    hed
-		    (loop (car tal)(cdr tal)))))))))
-
-(define (datashare:get-versions-for-area db area-name #!key (version-patt #f))
-  (let ((res '())
-	(data (make-hash-table)))
-    (sqlite3:for-each-row
-     (lambda (version-name submitter iteration submitted-time comment)
-       ;;                                              0           1         2           3           4
-       (hash-table-set! data version-name (vector version-name submitter iteration submitted-time comment)))
-     db 
-     "SELECT version_name,submitter,iteration,datetime,comment FROM pkgs WHERE area='megatest' AND version_name != 'latest' AND version_name LIKE ? ORDER BY datetime asc;"
-     (or version-patt "%"))
-    (map (lambda (x)(hash-table-ref data x))(sort (hash-table-keys data) string-ci>=))))
-
-;;======================================================================
-;; DATA IMPORT/EXPORT
-;;======================================================================
-
-(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          (datashare:get-id db area version iteration))
-	 (db          (datashare:open-db configdat)))
-    (if (> space-avail 10000) ;; dumb heuristic
-	(begin
-	  (create-directory targ-path #t)
-	  (datashare: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" (conc source-path "/") (conc targ-path "/")))))
-				      (process-wait pid)
-				      (datashare: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)
-	  (datashare:set-copied db id "no")
-	  (sqlite3:finalize! db)
-	  #f))))
-
-(define (datashare:get-areas configdat)
-  (let* ((areadat (configf:get-section configdat "areas"))
-	 (areas   (if areadat (map car areadat) '())))
-    areas))
-
-(define (datashare:publish configdat publish-type area-name version comment spath submitter quality)
-  ;; input checks
-  (cond 
-   ((not (member area-name (datashare:get-areas configdat)))
-    (cons #f (conc "Illegal area name \"" area-name "\"")))
-   (else
-    (let ((db          (datashare:open-db configdat))
-	  (iteration   (datashare:register-data db area-name version publish-type submitter quality spath comment))
-	  (dest-store  (datashare:get-best-storage configdat)))
-      (if iteration
-	  (if (eq? 'copy publish-type)
-	      (begin
-		(datashare:import-data configdat spath dest-store area-name version iteration)
-		(let ((id (datashare:get-id db area-name version iteration)))
-		  (datashare:set-latest db id area-name version iteration)))
-	      (let ((id (datashare:get-id db area-name version iteration)))
-		(datashare:set-stored-path db id spath)
-		(datashare:set-copied db id "yes")
-		(datashare:set-copied db id "n/a")
-		(datashare:set-latest db id area-name version iteration)))
-	  (print "ERROR: Failed to get an iteration number"))
-      (sqlite3:finalize! db)
-      (cons #t "Successfully saved data")))))
-
-(define (datashare:get-best-storage configdat)
-  (let* ((storage     (configf:lookup configdat "settings" "storage"))
-	 (store-areas (if storage (string-split storage) '())))
-    (print "Looking for available space in " store-areas)
-    (datashare:find-most-space store-areas)))
-
-;; (string->number (list-ref (with-input-from-pipe "df -B1000000 /tmp" (lambda ()(read-line)(string-split (read-line)))) 3))
-
-(define (datashare:find-most-space paths)
-  (fold (lambda (area res)
-	  ;; (print "area=" area " res=" res)
-	  (let ((maxspace (car res))
-		(currpath (cdr res)))
-	    ;; (print currpath " " maxspace)
-	    (if (file-write-access? area)
-		(let ((currspace (string->number
-				  (list-ref
-				   (with-input-from-pipe 
-				    ;; (conc "df --output=avail " area)
-				    (conc "df -B1000000 " area)
-				    ;; (lambda ()(read)(read))
-				    (lambda ()(read-line)(string-split (read-line))))
-				   3))))
-		  (if (> currspace maxspace) 
-		      (cons currspace area)
-		      res))
-		res)))
-	(cons 0 #f)
-	paths))
-
-;; remove existing link and if possible ...
-;; create path to next of tip of target, create link back to source
-(define (datashare:build-dir-make-link source target)
-  (if (common:file-exists? target)(datashare:backup-move target))
-  (create-directory (pathname-directory target) #t)
-  (create-symbolic-link source target))
-
-(define (datashare:backup-move path)
-  (let* ((trashdir  (conc (pathname-directory path) "/.trash"))
-	 (trashfile (conc trashdir "/" (current-seconds) "-" (pathname-file path))))
-    (create-directory trashdir #t)
-    (if (directory? path)
-	(system (conc "mv " path " " trashfile))
-	(file-move path trash-file))))
-
-;;======================================================================
-;; GUI
-;;======================================================================
-
-;; The main menu 
-(define (datashare:main-menu)
-  (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
-   (iup:menu-item "Files" (iup:menu   ;; Note that you can use either #:action or action: for options
-		       (iup:menu-item "Open"  action: (lambda (obj)
-							(iup:show (iup:file-dialog))
-							(print "File->open " obj)))
-		       (iup:menu-item "Save"  #:action (lambda (obj)(print "File->save " obj)))
-		       (iup:menu-item "Exit"  #:action (lambda (obj)(exit)))))
-   (iup:menu-item "Tools" (iup:menu
-		       (iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
-		       ;; (iup:menu-item "Show dialog"     #:action (lambda (obj)
-		       ;;  					   (show message-window
-		       ;;  					     #:modal? #t
-		       ;;  					     ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
-		       ;;  					     ;; #:x 'mouse
-		       ;;  					     ;; #:y 'mouse
-		       ;;  )					     
-		       ))))
-
-(define (datashare:publish-view configdat)
-  ;; (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"))
-	 ;; (copy-link   (iup:toggle  #:expand "HORIZONTAL"))
-	 ;; (iteration   (iup:textbox #:expand "YES" #:size "20x"))
-	 ;; (iteration   (iup:textbox #:expand "HORIZONTAL" #:size "20x"))
-	 (area-filter (iup:textbox #:expand "HORIZONTAL" #:value "%"))
-	 (comment-tb  (iup:textbox #:expand "YES" #:multiline "YES"))
-	 (source-tb   (iup:textbox #:expand "HORIZONTAL"
-				   #:value (or (configf:lookup configdat "settings" "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"))
-			       (submitter   (current-user-name))
-			       (quality     2))
-			  (datashare:publish configdat publish-type area-name version comment spath submitter quality))))
-	 (copy        (iup:button "Copy and Publish"
-				  #:expand "HORIZONTAL"
-				  #:action (lambda (obj)
-					     (publish 'copy))))
-	 (link        (iup:button "Link and Publish"
-				  #:expand "HORIZONTAL"
-				  #:action (lambda (obj)
-					     (publish 'link))))
-	 (browse-btn  (iup:button "Browse"
-				  #:size "40x"
-				  #:action (lambda (obj)
-					     (let* ((fd  (iup:file-dialog #:dialogtype "DIR"))
-						    (top (iup:show fd #:modal? "YES")))
-					       (iup:attribute-set! source-tb "VALUE"
-								   (iup:attribute fd "VALUE"))
-					       (iup:destroy! fd))))))
-    (print "areas")
-    ;; (pp areas)
-    (fold (lambda (areadat num)
-	    ;; (print "Adding num=" num ", areadat=" areadat)
-	    (iup:attribute-set! areas-sel (conc num) (car areadat))
-	    (+ 1 num))
-	  1 areas)
-    (iup:vbox
-     (iup:hbox (iup:label "Area:"        #:size label-size) ;; area-filter 
-	       areas-sel)
-     (iup:hbox (iup:label "Version:"     #:size label-size)   version-tb)
-     ;; (iup:hbox (iup:label "Link only"    #:size label-size)   copy-link)
-     ;; 	       (iup:label "Iteration:")   iteration)
-     (iup:hbox (iup:label "Comment:"     #:size label-size)   comment-tb)
-     (iup:hbox (iup:label "Source base path:" #:size label-size)   source-tb browse-btn)
-     (iup:hbox copy link))))
-
-(define (datashare:lst->path pathlst)
-  (conc "/" (string-intersperse (map conc pathlst) "/")))
-
-(define (datashare:path->lst path)
-  (string-split path "/"))
-
-(define (datashare:pathdat-apply-heuristics configdat path)
-  (cond
-   ((common:file-exists? path) "found")
-   (else (conc path " not installed"))))
-
-(define (datashare:get-view configdat)
-  (iup:vbox
-   (iup:hbox
-    (let* ((label-size     "60x")
-	   ;; filter elements
-	   (area-filter    "%")
-	   (version-filter "%")
-	   (iter-filter    ">= 0")
-	   ;; 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"
-			    #:addexpanded "NO"
-			    #:selection-cb
-			    (lambda (obj id state)
-			      ;; (print "obj: " obj ", id: " id ", state: " state)
-			      (let* ((path   (datashare:lst->path (cdr (tree:node->path obj id))))
-				     (record (hash-table-ref/default srcdat path #f)))
-				(if record
-				    (begin
-				      (set! curr-record record)
-				      (iup:attribute-set! submitter      "TITLE" (datashare:pkg-get-submitter record))
-				      (iup:attribute-set! date-submitted "TITLE" (time->string (seconds->local-time (datashare:pkg-get-datetime record))))
-				      (iup:attribute-set! comment        "TITLE" (datashare:pkg-get-comment record))
-				      (iup:attribute-set! quality        "TITLE" (datashare:pkg-get-quality record))
-				      (iup:attribute-set! copy-link      "TITLE" (datashare:pkg-get-store_type record))
-				      ))
-				;; (print  "id=" id " path=" path " record=" record);; (tree:node->path obj id) " run-id: " run-id)
-				))))
-	   (tb2             (iup:treebox
-			    #:value 0
-			    #:name "Installed"
-			    #:expand "YES"
-			    #:addexpanded "NO"
-			    #:selection-cb
-			    (lambda (obj id state)
-			      ;; (print "obj: " obj ", id: " id ", state: " state)
-			      (let* ((path   (datashare:lst->path (cdr (tree:node->path obj 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))
-				    (areas (or (configf:get-section configdat "areas") '())))
-			       ;;
-			       ;; first update the Sources
-			       ;;
-			       (for-each
-				(lambda (pkgitem)
-				  (let* ((pkg-path   (list (datashare:pkg-get-area  pkgitem)
-							   (datashare:pkg-get-version_name pkgitem)
-							   (datashare:pkg-get-iteration pkgitem)))
-					 (pkg-id     (datashare:pkg-get-id          pkgitem))
-					 (path       (datashare:lst->path pkg-path)))
-				    ;; (print "tree:add-node tb=" tb ", pkg-path=" pkg-path ", pkg-id=" pkg-id)
-				    (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! srcdat path pkgitem)))
-				(datashare:get-pkgs db area-filter version-filter iter-filter))
-			       ;;
-			       ;; 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" (datashare:path->lst path)))
-				    (hash-table-set! installed-dat path (datashare:pathdat-apply-heuristics configdat fullpath))))
-				areas)
-			       (sqlite3:finalize! db))))
-	   (apply          (iup:button "Apply"
-				       #:action
-				       (lambda (obj)
-					 (if curr-record
-					     (let* ((area        (datashare:pkg-get-area        curr-record))
-						    (stored-path (datashare:pkg-get-stored_path curr-record))
-						    (source-type (datashare:pkg-get-store_type  curr-record))
-						    (source-path (case source-type ;;  (equal? source-type "link"))
-								   ((link)(datashare:pkg-get-source-path curr-record))
-								   ((copy)stored-path)
-								   (else #f)))
-						    (dest-stub   (configf:lookup configdat "areas" area))
-						    (target-path (conc basepath "/" dest-stub)))
-					       (datashare:build-dir-make-link stored-path target-path)
-					       (print "Creating link from " stored-path " to " target-path)))))))
-      (iup:vbox 
-       (iup:hbox tb tb2)
-       (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 
-    (iup:button "Pushme"
-		#:expand "YES"
-		))))
-
-(define (datashare:gui configdat)
-  (iup:show
-   (iup:dialog 
-    #:title (conc "DataShare dashboard " (current-user-name) ":" (current-directory))   
-    #:menu (datashare:main-menu)
-    (let* ((tabs (iup:tabs
-		  #:tabchangepos-cb (lambda (obj curr prev)
-				      (set! *datashare:current-tab-number* curr))
-		  (datashare:publish-view configdat)
-		  (datashare:get-view configdat)
-		  (datashare:manage-view configdat)
-		  )))
-	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
-	(iup:attribute-set! tabs "TABTITLE0" "Publish")
-	(iup:attribute-set! tabs "TABTITLE1" "Get")
-	(iup:attribute-set! tabs "TABTITLE2" "Manage")
-	;; (iup:attribute-set! tabs "BGCOLOR" "190 190 190")
-	tabs)))
-  (iup:main-loop))
-
-;;======================================================================
-;; MISC
-;;======================================================================
-
-
-(define (datashare:do-as-calling-user proc)
-  (let ((eid (current-effective-user-id))
-        (cid (current-user-id)))
-    (if (not (eq? eid cid)) ;; running suid
-            (set! (current-effective-user-id) cid))
-    ;; (print "running as " (current-effective-user-id))
-    (proc)
-    (if (not (eq? eid cid))
-        (set! (current-effective-user-id) eid))))
-
-(define (datashare:find name paths)
-  (if (null? paths)
-      #f
-      (let loop ((hed (car paths))
-		 (tal (cdr paths)))
-	(if (common:file-exists? (conc hed "/" name))
-	    hed
-	    (if (null? tal)
-		#f
-		(loop (car tal)(cdr tal)))))))
-
-;;======================================================================
-;; MAIN
-;;======================================================================
-
-(define (datashare:load-config exe-dir exe-name)
-  (let* ((fname   (conc exe-dir "/." exe-name ".config")))
-    (ini:property-separator-patt " *  *")
-    (ini:property-separator #\space)
-    (if (common:file-exists? fname)
-	;; (ini:read-ini fname)
-	(read-config fname #f #t)
-	(make-hash-table))))
-
-(define (datashare:process-action configdat action . args)
-  (case (string->symbol action)
-    ((get)
-     (if (< (length args) 2)
-	 (begin 
-	   (print "ERROR: Missing arguments; " (string-intersperse args ", "))
-	   (exit 1))
-	 (let* ((basepath    (configf:lookup configdat "settings" "basepath"))
-		(db          (datashare:open-db configdat))
-		(area        (car args))
-		(version     (cadr args)) ;;    iteration
-		(remargs     (args:get-args args '("-i") '() args:arg-hash 0))
-		(iteration   (if (args:get-arg "-i")(string->number (args:get-arg "-i")) #f))
-		(curr-record (datashare:get-pkg db area version iteration: iteration)))
-	   (if (not curr-record)
-	       (begin
-		 (print "ERROR: No matching record found; area=" area ", version=" version ", iteration=" (if iteration iteration "(max)"))
-		 (exit 1))
-	       (let* ((stored-path (datashare:pkg-get-stored_path curr-record))
-		      (source-type (datashare:pkg-get-store_type  curr-record))
-		      (source-path (case source-type ;;  (equal? source-type "link"))
-				     ((link) (datashare:pkg-get-source-path curr-record))
-				     ((copy) stored-path)
-				     (else #f)))
-		      (dest-stub   (configf:lookup configdat "areas" area))
-		      (target-path (conc basepath "/" dest-stub)))
-		 (datashare:build-dir-make-link stored-path target-path)
-		 (datashare:record-pkg-ref db (datashare:pkg-get-id curr-record) target-path)
-		 (sqlite3:finalize! db)
-		 (print "Creating link from " stored-path " to " target-path))))))
-    ((publish)
-     (if (< (length args) 3)
-	 (begin 
-	   (print "ERROR: Missing arguments; " (string-intersperse args ", "))
-	   (exit 1))
-	 (let* ((srcpath  (list-ref args 0))
-		(areaname (list-ref args 1))
-		(version  (list-ref args 2))
-		(remargs  (args:get-args (drop args 2)
-					 '("-type" ;; link or copy (default is copy)
-					   "-m")
- 					 '()
- 					 args:arg-hash
- 					 0))
-		(publish-type (if (equal? (args:get-arg "-type") "link") 'link 'copy))
-		(comment      (or (args:get-arg "-m") ""))
-		(submitter    (current-user-name))
-		(quality      (args:get-arg "-quality"))
-		(publish-res  (datashare:publish configdat publish-type areaname version comment srcpath submitter quality)))
-	   (if (not (car publish-res))
-	       (begin
-		 (print "ERROR: " (cdr publish-res))
-		 (exit 1))))))
-    ((list-versions)
-     (let ((area-name (car args)) ;;      version patt   full print
-	   (remargs   (args:get-args args '("-vpatt") '("-full") args:arg-hash 0))
-	   (db        (datashare:open-db configdat))
-	   (versions  (datashare:get-versions-for-area db (car args) version-patt: (args:get-arg "-vpatt"))))
-       ;; (print "area-name=" area-name " args=" args " *args-hash*=" (hash-table->alist *args-hash*))
-       (map (lambda (x)
-	      (if (args:get-arg "-full")
-		  (format #t 
-			  "~10a~10a~4a~27a~30a\n"
-			  (vector-ref x 0)
-			  (vector-ref x 1) 
-			  (vector-ref x 2) 
-			  (conc "\"" (time->string (seconds->local-time (vector-ref x 3))) "\"")
-			  (conc "\"" (vector-ref x 4) "\""))
-		  (print (vector-ref x 0))))
-	    versions)
-       (sqlite3:finalize! db)))))
-
-;; ease debugging by loading ~/.dashboardrc - REMOVE FROM PRODUCTION!
-(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.datasharerc")))
-  (if (common:file-exists? debugcontrolf)
-      (load debugcontrolf)))
-
-(define (main)
-  (let* ((args      (argv))
-	 (prog      (car args))
-	 (rema      (cdr args))
-	 (exe-name  (pathname-file (car (argv))))
-	 (exe-dir   (or (pathname-directory prog)
-			(datashare:find exe-name (string-split (get-environment-variable "PATH") ":"))))
-	 (configdat (datashare:load-config exe-dir exe-name)))
-    (cond
-     ;; one-word commands
-     ((eq? (length rema) 1)
-      (case (string->symbol (car rema))
-	((help -h -help --h --help)
-	 (print datashare:help))
-	((list-areas)
-	 (map print (datashare:get-areas configdat)))
-	(else
-	 (print "ERROR: Unrecognised command. Try \"datashare help\""))))
-     ;; multi-word commands
-     ((null? rema)(datashare:gui configdat))
-     ((>= (length rema) 2)
-      (apply datashare:process-action configdat (car rema)(cdr rema)))
-     (else (print "ERROR: Unrecognised command. Try \"datashare help\"")))))
-
-(main)
+;; ==> (module datashare
+;; ==> (use ssax)
+;; ==> (use sxml-serializer)
+;; ==> (use sxml-modifications)
+;; ==> (use regex)
+;; ==> (use srfi-69)
+;; ==> (use regex-case)
+;; ==> (use posix)
+;; ==> (use json)
+;; ==> (use csv)
+;; ==> (use srfi-18)
+;; ==> (use format)
+;; ==> 
+;; ==> (use (prefix iup iup:))
+;; ==> (import (prefix ini-file ini:))
+;; ==> 
+;; ==> (use canvas-draw)
+;; ==> (import canvas-draw-iup)
+;; ==> 
+;; ==> (use sqlite3 srfi-1 posix regex regex-case srfi-69)
+;; ==> (import (prefix sqlite3 sqlite3:))
+;; ==> 
+;; ==> (declare (uses configf))
+;; ==> (declare (uses tree))
+;; ==> (declare (uses margs))
+;; ==> ;; (declare (uses dcommon))
+;; ==> ;; (declare (uses launch))
+;; ==> ;; (declare (uses gutils))
+;; ==> ;; (declare (uses db))
+;; ==> ;; (declare (uses synchash))
+;; ==> ;; (declare (uses server))
+;; ==> ;; (declare (uses megatest-version))
+;; ==> ;; (declare (uses tbd))
+;; ==> 
+;; ==> (include "megatest-fossil-hash.scm")
+;; ==> 
+;; ==> ;;
+;; ==> ;; GLOBALS
+;; ==> ;;
+;; ==> (define *datashare:current-tab-number* 0)
+;; ==> (define *args-hash* (make-hash-table))
+;; ==> (define datashare:help (conc "Usage: datashare [action [params ...]]
+;; ==> 
+;; ==> Note: run datashare without parameters to start the gui.
+;; ==> 
+;; ==>   list-areas                          : List the allowed areas
+;; ==> 
+;; ==>   list-versions <area>                : List versions available in <area>
+;; ==>          options : -full, -vpatt patt
+;; ==> 
+;; ==>   publish <path> <area> <version>     : Publish data for area and with version
+;; ==> 
+;; ==>   get <area> <version>                : Get a link to data, put the link in destpath
+;; ==>          options : -i iteration
+;; ==> 
+;; ==>   update <area>                       : Update the link to data to the latest iteration.
+;; ==> 
+;; ==> Part of the Megatest tool suite.
+;; ==> Learn more at http://www.kiatoa.com/fossils/megatest
+;; ==> 
+;; ==> Version: " megatest-fossil-hash)) ;; "
+;; ==> 
+;; ==> ;;======================================================================
+;; ==> ;; 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-datashare:pkg)(make-vector 15))
+;; ==> (define-inline (datashare:pkg-get-id             vec)    (vector-ref  vec 0))
+;; ==> (define-inline (datashare:pkg-get-area           vec)    (vector-ref  vec 1))
+;; ==> (define-inline (datashare:pkg-get-version_name   vec)    (vector-ref  vec 2))
+;; ==> (define-inline (datashare:pkg-get-store_type     vec)    (vector-ref  vec 3))
+;; ==> (define-inline (datashare:pkg-get-copied         vec)    (vector-ref  vec 4))
+;; ==> (define-inline (datashare:pkg-get-source_path    vec)    (vector-ref  vec 5))
+;; ==> (define-inline (datashare:pkg-get-iteration      vec)    (vector-ref  vec 6))
+;; ==> (define-inline (datashare:pkg-get-submitter      vec)    (vector-ref  vec 7))
+;; ==> (define-inline (datashare:pkg-get-datetime       vec)    (vector-ref  vec 8))
+;; ==> (define-inline (datashare:pkg-get-storegrp       vec)    (vector-ref  vec 9))
+;; ==> (define-inline (datashare:pkg-get-datavol        vec)    (vector-ref  vec 10))
+;; ==> (define-inline (datashare:pkg-get-quality        vec)    (vector-ref  vec 11))
+;; ==> (define-inline (datashare:pkg-get-disk_id        vec)    (vector-ref  vec 12))
+;; ==> (define-inline (datashare:pkg-get-comment        vec)    (vector-ref  vec 13))
+;; ==> (define-inline (datashare:pkg-get-stored_path    vec)    (vector-ref  vec 14))
+;; ==> (define-inline (datashare:pkg-set-id!            vec val)(vector-set! vec 0 val))
+;; ==> (define-inline (datashare:pkg-set-area!          vec val)(vector-set! vec 1 val))
+;; ==> (define-inline (datashare:pkg-set-version_name!  vec val)(vector-set! vec 2 val))
+;; ==> (define-inline (datashare:pkg-set-store_type!    vec val)(vector-set! vec 3 val))
+;; ==> (define-inline (datashare:pkg-set-copied!        vec val)(vector-set! vec 4 val))
+;; ==> (define-inline (datashare:pkg-set-source_path!   vec val)(vector-set! vec 5 val))
+;; ==> (define-inline (datashare:pkg-set-iteration!     vec val)(vector-set! vec 6 val))
+;; ==> (define-inline (datashare:pkg-set-submitter!     vec val)(vector-set! vec 7 val))
+;; ==> (define-inline (datashare:pkg-set-datetime!      vec val)(vector-set! vec 8 val))
+;; ==> (define-inline (datashare:pkg-set-storegrp!      vec val)(vector-set! vec 9 val))
+;; ==> (define-inline (datashare:pkg-set-datavol!       vec val)(vector-set! vec 10 val))
+;; ==> (define-inline (datashare:pkg-set-quality!       vec val)(vector-set! vec 11 val))
+;; ==> (define-inline (datashare:pkg-set-disk_id!       vec val)(vector-set! vec 12 val))
+;; ==> (define-inline (datashare:pkg-set-comment!       vec val)(vector-set! vec 13 val))
+;; ==> (define-inline (datashare:pkg-set-stored_path!   vec val)(vector-set! vec 14 val))
+;; ==> 
+;; ==> ;;======================================================================
+;; ==> ;; DB
+;; ==> ;;======================================================================
+;; ==> 
+;; ==> (define (datashare:initialize-db db)
+;; ==>   (for-each
+;; ==>    (lambda (qry)
+;; ==>      (sqlite3:execute db qry))
+;; ==>    (list 
+;; ==>     "CREATE TABLE pkgs 
+;; ==>          (id           INTEGER PRIMARY KEY,
+;; ==>           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,
+;; ==>           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 (conc store-type) submitter source-path quality comment)))
+;; ==>     (sqlite3:finalize! iter-qry)
+;; ==>     next-iteration))
+;; ==> 
+;; ==> (define (datashare: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 (datashare:set-stored-path db id path)
+;; ==>   (sqlite3:execute db "UPDATE pkgs SET stored_path=? WHERE id=?;" path id))
+;; ==> 
+;; ==> (define (datashare: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)
+;; ==>   (let ((res #f))
+;; ==>     (sqlite3:for-each-row
+;; ==>      (lambda (a . b)
+;; ==>        (set! res (apply vector a b)))
+;; ==>      db 
+;; ==>      "SELECT * FROM pkgs WHERE area=? AND version_name=? AND iteration=?;"
+;; ==>      area 
+;; ==>      version-name
+;; ==>      iteration)
+;; ==>     res))
+;; ==> 
+;; ==> ;; take version-name iteration and register or update "lastest/0"
+;; ==> ;;
+;; ==> (define (datashare:set-latest db id area version-name iteration)
+;; ==>   (let* ((rec         (datashare:get-pkg-record db area version-name iteration))
+;; ==> 	 (latest-id   (datashare:get-id db area "latest" 0))
+;; ==> 	 (stored-path (datashare:pkg-get-stored_path rec)))
+;; ==>     (if latest-id ;; have a record - bump the link pointer
+;; ==> 	(datashare:set-stored-path db latest-id stored-path)
+;; ==> 	(datashare:register-data db area "latest" 'link "auto" "na" stored-path "latest data"))))
+;; ==> 
+;; ==> ;; set a package ref, this is the location where the link back to the stored data 
+;; ==> ;; is put. 
+;; ==> ;;
+;; ==> ;; if there is nothing at that location then the record can be removed
+;; ==> ;; if there are no refs for a particular pkg-id then that pkg-id is a 
+;; ==> ;; candidate for removal
+;; ==> ;;
+;; ==> (define (datashare:record-pkg-ref db pkg-id dest-link)
+;; ==>   (sqlite3:execute db "INSERT INTO refs (pkg_id,destlink) VALUES (?,?);" pkg-id dest-link))
+;; ==>   
+;; ==> (define (datashare:count-refs db pkg-id)
+;; ==>   (let ((res 0))
+;; ==>     (sqlite3:for-each-row
+;; ==>      (lambda (count)
+;; ==>        (set! res count))
+;; ==>      db
+;; ==>      "SELECT count(id) FROM refs WHERE pkg_id=?;"
+;; ==>      pkg-id)
+;; ==>     res))
+;; ==> 
+;; ==> ;; Create the sqlite 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  (common:file-exists? dbpath))
+;; ==> 	       (handler   (make-busy-timeout 136000)))
+;; ==> 	  (handle-exceptions
+;; ==> 	   exn
+;; ==> 	   (begin
+;; ==> 	     (debug:print 2 *default-log-port* "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 (current-error-port))
+;; ==>         (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)
+;; ==> 
+;; ==> (define (datashare:get-pkgs db area-filter version-filter iter-filter)
+;; ==>   (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,stored_path "
+;; ==> 	   " FROM pkgs WHERE area like ? AND version_name LIKE ? AND iteration " iter-filter ";")
+;; ==>      area-filter version-filter)
+;; ==>     (reverse res)))
+;; ==> 
+;; ==> (define (datashare:get-pkg db area-name version-name #!key (iteration #f))
+;; ==>   (let ((dat '())
+;; ==> 	(res #f))
+;; ==>     (sqlite3:for-each-row ;; replace with fold ...
+;; ==>      (lambda (a . b)
+;; ==>        (set! dat (cons (list->vector (cons a b)) dat)))
+;; ==>      db 
+;; ==>      (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=? AND version_name=? ORDER BY iteration ASC;")
+;; ==>      area-name version-name)
+;; ==>     ;; now filter for iteration, either max if #f or specific one
+;; ==>     (if (null? dat)
+;; ==> 	#f
+;; ==> 	(let loop ((hed (car dat))
+;; ==> 		   (tal (cdr dat))
+;; ==> 		   (cur 0))
+;; ==> 	  (let ((itr (datashare:pkg-get-iteration hed)))
+;; ==> 	    (if (equal? itr iteration) ;; this is the one if iteration is specified
+;; ==> 		hed
+;; ==> 		(if (null? tal)
+;; ==> 		    hed
+;; ==> 		    (loop (car tal)(cdr tal)))))))))
+;; ==> 
+;; ==> (define (datashare:get-versions-for-area db area-name #!key (version-patt #f))
+;; ==>   (let ((res '())
+;; ==> 	(data (make-hash-table)))
+;; ==>     (sqlite3:for-each-row
+;; ==>      (lambda (version-name submitter iteration submitted-time comment)
+;; ==>        ;;                                              0           1         2           3           4
+;; ==>        (hash-table-set! data version-name (vector version-name submitter iteration submitted-time comment)))
+;; ==>      db 
+;; ==>      "SELECT version_name,submitter,iteration,datetime,comment FROM pkgs WHERE area='megatest' AND version_name != 'latest' AND version_name LIKE ? ORDER BY datetime asc;"
+;; ==>      (or version-patt "%"))
+;; ==>     (map (lambda (x)(hash-table-ref data x))(sort (hash-table-keys data) string-ci>=))))
+;; ==> 
+;; ==> ;;======================================================================
+;; ==> ;; DATA IMPORT/EXPORT
+;; ==> ;;======================================================================
+;; ==> 
+;; ==> (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          (datashare:get-id db area version iteration))
+;; ==> 	 (db          (datashare:open-db configdat)))
+;; ==>     (if (> space-avail 10000) ;; dumb heuristic
+;; ==> 	(begin
+;; ==> 	  (create-directory targ-path #t)
+;; ==> 	  (datashare: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" (conc source-path "/") (conc targ-path "/")))))
+;; ==> 				      (process-wait pid)
+;; ==> 				      (datashare: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)
+;; ==> 	  (datashare:set-copied db id "no")
+;; ==> 	  (sqlite3:finalize! db)
+;; ==> 	  #f))))
+;; ==> 
+;; ==> (define (datashare:get-areas configdat)
+;; ==>   (let* ((areadat (configf:get-section configdat "areas"))
+;; ==> 	 (areas   (if areadat (map car areadat) '())))
+;; ==>     areas))
+;; ==> 
+;; ==> (define (datashare:publish configdat publish-type area-name version comment spath submitter quality)
+;; ==>   ;; input checks
+;; ==>   (cond 
+;; ==>    ((not (member area-name (datashare:get-areas configdat)))
+;; ==>     (cons #f (conc "Illegal area name \"" area-name "\"")))
+;; ==>    (else
+;; ==>     (let ((db          (datashare:open-db configdat))
+;; ==> 	  (iteration   (datashare:register-data db area-name version publish-type submitter quality spath comment))
+;; ==> 	  (dest-store  (datashare:get-best-storage configdat)))
+;; ==>       (if iteration
+;; ==> 	  (if (eq? 'copy publish-type)
+;; ==> 	      (begin
+;; ==> 		(datashare:import-data configdat spath dest-store area-name version iteration)
+;; ==> 		(let ((id (datashare:get-id db area-name version iteration)))
+;; ==> 		  (datashare:set-latest db id area-name version iteration)))
+;; ==> 	      (let ((id (datashare:get-id db area-name version iteration)))
+;; ==> 		(datashare:set-stored-path db id spath)
+;; ==> 		(datashare:set-copied db id "yes")
+;; ==> 		(datashare:set-copied db id "n/a")
+;; ==> 		(datashare:set-latest db id area-name version iteration)))
+;; ==> 	  (print "ERROR: Failed to get an iteration number"))
+;; ==>       (sqlite3:finalize! db)
+;; ==>       (cons #t "Successfully saved data")))))
+;; ==> 
+;; ==> (define (datashare:get-best-storage configdat)
+;; ==>   (let* ((storage     (configf:lookup configdat "settings" "storage"))
+;; ==> 	 (store-areas (if storage (string-split storage) '())))
+;; ==>     (print "Looking for available space in " store-areas)
+;; ==>     (datashare:find-most-space store-areas)))
+;; ==> 
+;; ==> ;; (string->number (list-ref (with-input-from-pipe "df -B1000000 /tmp" (lambda ()(read-line)(string-split (read-line)))) 3))
+;; ==> 
+;; ==> (define (datashare:find-most-space paths)
+;; ==>   (fold (lambda (area res)
+;; ==> 	  ;; (print "area=" area " res=" res)
+;; ==> 	  (let ((maxspace (car res))
+;; ==> 		(currpath (cdr res)))
+;; ==> 	    ;; (print currpath " " maxspace)
+;; ==> 	    (if (file-write-access? area)
+;; ==> 		(let ((currspace (string->number
+;; ==> 				  (list-ref
+;; ==> 				   (with-input-from-pipe 
+;; ==> 				    ;; (conc "df --output=avail " area)
+;; ==> 				    (conc "df -B1000000 " area)
+;; ==> 				    ;; (lambda ()(read)(read))
+;; ==> 				    (lambda ()(read-line)(string-split (read-line))))
+;; ==> 				   3))))
+;; ==> 		  (if (> currspace maxspace) 
+;; ==> 		      (cons currspace area)
+;; ==> 		      res))
+;; ==> 		res)))
+;; ==> 	(cons 0 #f)
+;; ==> 	paths))
+;; ==> 
+;; ==> ;; remove existing link and if possible ...
+;; ==> ;; create path to next of tip of target, create link back to source
+;; ==> (define (datashare:build-dir-make-link source target)
+;; ==>   (if (common:file-exists? target)(datashare:backup-move target))
+;; ==>   (create-directory (pathname-directory target) #t)
+;; ==>   (create-symbolic-link source target))
+;; ==> 
+;; ==> (define (datashare:backup-move path)
+;; ==>   (let* ((trashdir  (conc (pathname-directory path) "/.trash"))
+;; ==> 	 (trashfile (conc trashdir "/" (current-seconds) "-" (pathname-file path))))
+;; ==>     (create-directory trashdir #t)
+;; ==>     (if (directory? path)
+;; ==> 	(system (conc "mv " path " " trashfile))
+;; ==> 	(file-move path trash-file))))
+;; ==> 
+;; ==> ;;======================================================================
+;; ==> ;; GUI
+;; ==> ;;======================================================================
+;; ==> 
+;; ==> ;; The main menu 
+;; ==> (define (datashare:main-menu)
+;; ==>   (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
+;; ==>    (iup:menu-item "Files" (iup:menu   ;; Note that you can use either #:action or action: for options
+;; ==> 		       (iup:menu-item "Open"  action: (lambda (obj)
+;; ==> 							(iup:show (iup:file-dialog))
+;; ==> 							(print "File->open " obj)))
+;; ==> 		       (iup:menu-item "Save"  #:action (lambda (obj)(print "File->save " obj)))
+;; ==> 		       (iup:menu-item "Exit"  #:action (lambda (obj)(exit)))))
+;; ==>    (iup:menu-item "Tools" (iup:menu
+;; ==> 		       (iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
+;; ==> 		       ;; (iup:menu-item "Show dialog"     #:action (lambda (obj)
+;; ==> 		       ;;  					   (show message-window
+;; ==> 		       ;;  					     #:modal? #t
+;; ==> 		       ;;  					     ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
+;; ==> 		       ;;  					     ;; #:x 'mouse
+;; ==> 		       ;;  					     ;; #:y 'mouse
+;; ==> 		       ;;  )					     
+;; ==> 		       ))))
+;; ==> 
+;; ==> (define (datashare:publish-view configdat)
+;; ==>   ;; (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"))
+;; ==> 	 ;; (copy-link   (iup:toggle  #:expand "HORIZONTAL"))
+;; ==> 	 ;; (iteration   (iup:textbox #:expand "YES" #:size "20x"))
+;; ==> 	 ;; (iteration   (iup:textbox #:expand "HORIZONTAL" #:size "20x"))
+;; ==> 	 (area-filter (iup:textbox #:expand "HORIZONTAL" #:value "%"))
+;; ==> 	 (comment-tb  (iup:textbox #:expand "YES" #:multiline "YES"))
+;; ==> 	 (source-tb   (iup:textbox #:expand "HORIZONTAL"
+;; ==> 				   #:value (or (configf:lookup configdat "settings" "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"))
+;; ==> 			       (submitter   (current-user-name))
+;; ==> 			       (quality     2))
+;; ==> 			  (datashare:publish configdat publish-type area-name version comment spath submitter quality))))
+;; ==> 	 (copy        (iup:button "Copy and Publish"
+;; ==> 				  #:expand "HORIZONTAL"
+;; ==> 				  #:action (lambda (obj)
+;; ==> 					     (publish 'copy))))
+;; ==> 	 (link        (iup:button "Link and Publish"
+;; ==> 				  #:expand "HORIZONTAL"
+;; ==> 				  #:action (lambda (obj)
+;; ==> 					     (publish 'link))))
+;; ==> 	 (browse-btn  (iup:button "Browse"
+;; ==> 				  #:size "40x"
+;; ==> 				  #:action (lambda (obj)
+;; ==> 					     (let* ((fd  (iup:file-dialog #:dialogtype "DIR"))
+;; ==> 						    (top (iup:show fd #:modal? "YES")))
+;; ==> 					       (iup:attribute-set! source-tb "VALUE"
+;; ==> 								   (iup:attribute fd "VALUE"))
+;; ==> 					       (iup:destroy! fd))))))
+;; ==>     (print "areas")
+;; ==>     ;; (pp areas)
+;; ==>     (fold (lambda (areadat num)
+;; ==> 	    ;; (print "Adding num=" num ", areadat=" areadat)
+;; ==> 	    (iup:attribute-set! areas-sel (conc num) (car areadat))
+;; ==> 	    (+ 1 num))
+;; ==> 	  1 areas)
+;; ==>     (iup:vbox
+;; ==>      (iup:hbox (iup:label "Area:"        #:size label-size) ;; area-filter 
+;; ==> 	       areas-sel)
+;; ==>      (iup:hbox (iup:label "Version:"     #:size label-size)   version-tb)
+;; ==>      ;; (iup:hbox (iup:label "Link only"    #:size label-size)   copy-link)
+;; ==>      ;; 	       (iup:label "Iteration:")   iteration)
+;; ==>      (iup:hbox (iup:label "Comment:"     #:size label-size)   comment-tb)
+;; ==>      (iup:hbox (iup:label "Source base path:" #:size label-size)   source-tb browse-btn)
+;; ==>      (iup:hbox copy link))))
+;; ==> 
+;; ==> (define (datashare:lst->path pathlst)
+;; ==>   (conc "/" (string-intersperse (map conc pathlst) "/")))
+;; ==> 
+;; ==> (define (datashare:path->lst path)
+;; ==>   (string-split path "/"))
+;; ==> 
+;; ==> (define (datashare:pathdat-apply-heuristics configdat path)
+;; ==>   (cond
+;; ==>    ((common:file-exists? path) "found")
+;; ==>    (else (conc path " not installed"))))
+;; ==> 
+;; ==> (define (datashare:get-view configdat)
+;; ==>   (iup:vbox
+;; ==>    (iup:hbox
+;; ==>     (let* ((label-size     "60x")
+;; ==> 	   ;; filter elements
+;; ==> 	   (area-filter    "%")
+;; ==> 	   (version-filter "%")
+;; ==> 	   (iter-filter    ">= 0")
+;; ==> 	   ;; 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"
+;; ==> 			    #:addexpanded "NO"
+;; ==> 			    #:selection-cb
+;; ==> 			    (lambda (obj id state)
+;; ==> 			      ;; (print "obj: " obj ", id: " id ", state: " state)
+;; ==> 			      (let* ((path   (datashare:lst->path (cdr (tree:node->path obj id))))
+;; ==> 				     (record (hash-table-ref/default srcdat path #f)))
+;; ==> 				(if record
+;; ==> 				    (begin
+;; ==> 				      (set! curr-record record)
+;; ==> 				      (iup:attribute-set! submitter      "TITLE" (datashare:pkg-get-submitter record))
+;; ==> 				      (iup:attribute-set! date-submitted "TITLE" (time->string (seconds->local-time (datashare:pkg-get-datetime record))))
+;; ==> 				      (iup:attribute-set! comment        "TITLE" (datashare:pkg-get-comment record))
+;; ==> 				      (iup:attribute-set! quality        "TITLE" (datashare:pkg-get-quality record))
+;; ==> 				      (iup:attribute-set! copy-link      "TITLE" (datashare:pkg-get-store_type record))
+;; ==> 				      ))
+;; ==> 				;; (print  "id=" id " path=" path " record=" record);; (tree:node->path obj id) " run-id: " run-id)
+;; ==> 				))))
+;; ==> 	   (tb2             (iup:treebox
+;; ==> 			    #:value 0
+;; ==> 			    #:name "Installed"
+;; ==> 			    #:expand "YES"
+;; ==> 			    #:addexpanded "NO"
+;; ==> 			    #:selection-cb
+;; ==> 			    (lambda (obj id state)
+;; ==> 			      ;; (print "obj: " obj ", id: " id ", state: " state)
+;; ==> 			      (let* ((path   (datashare:lst->path (cdr (tree:node->path obj 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))
+;; ==> 				    (areas (or (configf:get-section configdat "areas") '())))
+;; ==> 			       ;;
+;; ==> 			       ;; first update the Sources
+;; ==> 			       ;;
+;; ==> 			       (for-each
+;; ==> 				(lambda (pkgitem)
+;; ==> 				  (let* ((pkg-path   (list (datashare:pkg-get-area  pkgitem)
+;; ==> 							   (datashare:pkg-get-version_name pkgitem)
+;; ==> 							   (datashare:pkg-get-iteration pkgitem)))
+;; ==> 					 (pkg-id     (datashare:pkg-get-id          pkgitem))
+;; ==> 					 (path       (datashare:lst->path pkg-path)))
+;; ==> 				    ;; (print "tree:add-node tb=" tb ", pkg-path=" pkg-path ", pkg-id=" pkg-id)
+;; ==> 				    (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! srcdat path pkgitem)))
+;; ==> 				(datashare:get-pkgs db area-filter version-filter iter-filter))
+;; ==> 			       ;;
+;; ==> 			       ;; 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" (datashare:path->lst path)))
+;; ==> 				    (hash-table-set! installed-dat path (datashare:pathdat-apply-heuristics configdat fullpath))))
+;; ==> 				areas)
+;; ==> 			       (sqlite3:finalize! db))))
+;; ==> 	   (apply          (iup:button "Apply"
+;; ==> 				       #:action
+;; ==> 				       (lambda (obj)
+;; ==> 					 (if curr-record
+;; ==> 					     (let* ((area        (datashare:pkg-get-area        curr-record))
+;; ==> 						    (stored-path (datashare:pkg-get-stored_path curr-record))
+;; ==> 						    (source-type (datashare:pkg-get-store_type  curr-record))
+;; ==> 						    (source-path (case source-type ;;  (equal? source-type "link"))
+;; ==> 								   ((link)(datashare:pkg-get-source-path curr-record))
+;; ==> 								   ((copy)stored-path)
+;; ==> 								   (else #f)))
+;; ==> 						    (dest-stub   (configf:lookup configdat "areas" area))
+;; ==> 						    (target-path (conc basepath "/" dest-stub)))
+;; ==> 					       (datashare:build-dir-make-link stored-path target-path)
+;; ==> 					       (print "Creating link from " stored-path " to " target-path)))))))
+;; ==>       (iup:vbox 
+;; ==>        (iup:hbox tb tb2)
+;; ==>        (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 
+;; ==>     (iup:button "Pushme"
+;; ==> 		#:expand "YES"
+;; ==> 		))))
+;; ==> 
+;; ==> (define (datashare:gui configdat)
+;; ==>   (iup:show
+;; ==>    (iup:dialog 
+;; ==>     #:title (conc "DataShare dashboard " (current-user-name) ":" (current-directory))   
+;; ==>     #:menu (datashare:main-menu)
+;; ==>     (let* ((tabs (iup:tabs
+;; ==> 		  #:tabchangepos-cb (lambda (obj curr prev)
+;; ==> 				      (set! *datashare:current-tab-number* curr))
+;; ==> 		  (datashare:publish-view configdat)
+;; ==> 		  (datashare:get-view configdat)
+;; ==> 		  (datashare:manage-view configdat)
+;; ==> 		  )))
+;; ==> 	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
+;; ==> 	(iup:attribute-set! tabs "TABTITLE0" "Publish")
+;; ==> 	(iup:attribute-set! tabs "TABTITLE1" "Get")
+;; ==> 	(iup:attribute-set! tabs "TABTITLE2" "Manage")
+;; ==> 	;; (iup:attribute-set! tabs "BGCOLOR" "190 190 190")
+;; ==> 	tabs)))
+;; ==>   (iup:main-loop))
+;; ==> 
+;; ==> ;;======================================================================
+;; ==> ;; MISC
+;; ==> ;;======================================================================
+;; ==> 
+;; ==> 
+;; ==> (define (datashare:do-as-calling-user proc)
+;; ==>   (let ((eid (current-effective-user-id))
+;; ==>         (cid (current-user-id)))
+;; ==>     (if (not (eq? eid cid)) ;; running suid
+;; ==>             (set! (current-effective-user-id) cid))
+;; ==>     ;; (print "running as " (current-effective-user-id))
+;; ==>     (proc)
+;; ==>     (if (not (eq? eid cid))
+;; ==>         (set! (current-effective-user-id) eid))))
+;; ==> 
+;; ==> (define (datashare:find name paths)
+;; ==>   (if (null? paths)
+;; ==>       #f
+;; ==>       (let loop ((hed (car paths))
+;; ==> 		 (tal (cdr paths)))
+;; ==> 	(if (common:file-exists? (conc hed "/" name))
+;; ==> 	    hed
+;; ==> 	    (if (null? tal)
+;; ==> 		#f
+;; ==> 		(loop (car tal)(cdr tal)))))))
+;; ==> 
+;; ==> ;;======================================================================
+;; ==> ;; MAIN
+;; ==> ;;======================================================================
+;; ==> 
+;; ==> (define (datashare:load-config exe-dir exe-name)
+;; ==>   (let* ((fname   (conc exe-dir "/." exe-name ".config")))
+;; ==>     (ini:property-separator-patt " *  *")
+;; ==>     (ini:property-separator #\space)
+;; ==>     (if (common:file-exists? fname)
+;; ==> 	;; (ini:read-ini fname)
+;; ==> 	(read-config fname #f #t)
+;; ==> 	(make-hash-table))))
+;; ==> 
+;; ==> (define (datashare:process-action configdat action . args)
+;; ==>   (case (string->symbol action)
+;; ==>     ((get)
+;; ==>      (if (< (length args) 2)
+;; ==> 	 (begin 
+;; ==> 	   (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+;; ==> 	   (exit 1))
+;; ==> 	 (let* ((basepath    (configf:lookup configdat "settings" "basepath"))
+;; ==> 		(db          (datashare:open-db configdat))
+;; ==> 		(area        (car args))
+;; ==> 		(version     (cadr args)) ;;    iteration
+;; ==> 		(remargs     (args:get-args args '("-i") '() args:arg-hash 0))
+;; ==> 		(iteration   (if (args:get-arg "-i")(string->number (args:get-arg "-i")) #f))
+;; ==> 		(curr-record (datashare:get-pkg db area version iteration: iteration)))
+;; ==> 	   (if (not curr-record)
+;; ==> 	       (begin
+;; ==> 		 (print "ERROR: No matching record found; area=" area ", version=" version ", iteration=" (if iteration iteration "(max)"))
+;; ==> 		 (exit 1))
+;; ==> 	       (let* ((stored-path (datashare:pkg-get-stored_path curr-record))
+;; ==> 		      (source-type (datashare:pkg-get-store_type  curr-record))
+;; ==> 		      (source-path (case source-type ;;  (equal? source-type "link"))
+;; ==> 				     ((link) (datashare:pkg-get-source-path curr-record))
+;; ==> 				     ((copy) stored-path)
+;; ==> 				     (else #f)))
+;; ==> 		      (dest-stub   (configf:lookup configdat "areas" area))
+;; ==> 		      (target-path (conc basepath "/" dest-stub)))
+;; ==> 		 (datashare:build-dir-make-link stored-path target-path)
+;; ==> 		 (datashare:record-pkg-ref db (datashare:pkg-get-id curr-record) target-path)
+;; ==> 		 (sqlite3:finalize! db)
+;; ==> 		 (print "Creating link from " stored-path " to " target-path))))))
+;; ==>     ((publish)
+;; ==>      (if (< (length args) 3)
+;; ==> 	 (begin 
+;; ==> 	   (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+;; ==> 	   (exit 1))
+;; ==> 	 (let* ((srcpath  (list-ref args 0))
+;; ==> 		(areaname (list-ref args 1))
+;; ==> 		(version  (list-ref args 2))
+;; ==> 		(remargs  (args:get-args (drop args 2)
+;; ==> 					 '("-type" ;; link or copy (default is copy)
+;; ==> 					   "-m")
+;; ==>  					 '()
+;; ==>  					 args:arg-hash
+;; ==>  					 0))
+;; ==> 		(publish-type (if (equal? (args:get-arg "-type") "link") 'link 'copy))
+;; ==> 		(comment      (or (args:get-arg "-m") ""))
+;; ==> 		(submitter    (current-user-name))
+;; ==> 		(quality      (args:get-arg "-quality"))
+;; ==> 		(publish-res  (datashare:publish configdat publish-type areaname version comment srcpath submitter quality)))
+;; ==> 	   (if (not (car publish-res))
+;; ==> 	       (begin
+;; ==> 		 (print "ERROR: " (cdr publish-res))
+;; ==> 		 (exit 1))))))
+;; ==>     ((list-versions)
+;; ==>      (let ((area-name (car args)) ;;      version patt   full print
+;; ==> 	   (remargs   (args:get-args args '("-vpatt") '("-full") args:arg-hash 0))
+;; ==> 	   (db        (datashare:open-db configdat))
+;; ==> 	   (versions  (datashare:get-versions-for-area db (car args) version-patt: (args:get-arg "-vpatt"))))
+;; ==>        ;; (print "area-name=" area-name " args=" args " *args-hash*=" (hash-table->alist *args-hash*))
+;; ==>        (map (lambda (x)
+;; ==> 	      (if (args:get-arg "-full")
+;; ==> 		  (format #t 
+;; ==> 			  "~10a~10a~4a~27a~30a\n"
+;; ==> 			  (vector-ref x 0)
+;; ==> 			  (vector-ref x 1) 
+;; ==> 			  (vector-ref x 2) 
+;; ==> 			  (conc "\"" (time->string (seconds->local-time (vector-ref x 3))) "\"")
+;; ==> 			  (conc "\"" (vector-ref x 4) "\""))
+;; ==> 		  (print (vector-ref x 0))))
+;; ==> 	    versions)
+;; ==>        (sqlite3:finalize! db)))))
+;; ==> 
+;; ==> ;; ease debugging by loading ~/.dashboardrc - REMOVE FROM PRODUCTION!
+;; ==> (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.datasharerc")))
+;; ==>   (if (common:file-exists? debugcontrolf)
+;; ==>       (load debugcontrolf)))
+;; ==> 
+;; ==> (define (main)
+;; ==>   (let* ((args      (argv))
+;; ==> 	 (prog      (car args))
+;; ==> 	 (rema      (cdr args))
+;; ==> 	 (exe-name  (pathname-file (car (argv))))
+;; ==> 	 (exe-dir   (or (pathname-directory prog)
+;; ==> 			(datashare:find exe-name (string-split (get-environment-variable "PATH") ":"))))
+;; ==> 	 (configdat (datashare:load-config exe-dir exe-name)))
+;; ==>     (cond
+;; ==>      ;; one-word commands
+;; ==>      ((eq? (length rema) 1)
+;; ==>       (case (string->symbol (car rema))
+;; ==> 	((help -h -help --h --help)
+;; ==> 	 (print datashare:help))
+;; ==> 	((list-areas)
+;; ==> 	 (map print (datashare:get-areas configdat)))
+;; ==> 	(else
+;; ==> 	 (print "ERROR: Unrecognised command. Try \"datashare help\""))))
+;; ==>      ;; multi-word commands
+;; ==>      ((null? rema)(datashare:gui configdat))
+;; ==>      ((>= (length rema) 2)
+;; ==>       (apply datashare:process-action configdat (car rema)(cdr rema)))
+;; ==>      (else (print "ERROR: Unrecognised command. Try \"datashare help\"")))))
+;; ==> 
+;; ==> (main)