Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -203,10 +203,13 @@
 # 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/sd : datashare.scm $(OFILES)
 	csc datashare.scm $(OFILES) -o datashare-testing/sd
 
+datashare-testing/sdat: sharedat.scm $(OFILES)
+	csc sharedat.scm $(OFILES) -o datashare-testing/sdat
+
 sd : datashare-testing/sd
 	mkdir -p /tmp/$(USER)/datashare/disk1 /tmp/$(USER)/basepath
 
 xterm : sd
 	(export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)

ADDED   sharedat.scm
Index: sharedat.scm
==================================================================
--- /dev/null
+++ sharedat.scm
@@ -0,0 +1,508 @@
+
+;; Copyright 2006-2013, Matthew Welland.
+;; 
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;; 
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+
+(use defstruct)
+
+;; (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 ini-file)
+(import (prefix ini-file ini:))
+
+(use sql-de-lite 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 *spublish:current-tab-number* 0)
+(define *args-hash* (make-hash-table))
+(define spublish:help (conc "Usage: spublish [action [params ...]]
+
+  ls                     : list contents of target area
+  cp|publish <src file> <relative dest>      : copy file to target area
+  mkdir <dir name>       : maks directory in target area  
+  rm <file>              : remove file <file> from target area
+  ln <target> <link name> : creates a symlink
+  log                    :
+
+  options:
+
+    -m \"message\"        : describe what was done
+
+Part of the Megatest tool suite.
+Learn more at http://www.kiatoa.com/fossils/megatest
+
+Version: " megatest-fossil-hash)) ;; "
+
+;;======================================================================
+;; RECORDS
+;;======================================================================
+
+;;======================================================================
+;; DB
+;;======================================================================
+
+(define (spublish:initialize-db db)
+  (for-each
+   (lambda (qry)
+     (exec (sql db qry)))
+   (list 
+    "CREATE TABLE IF NOT EXISTS actions
+         (id           INTEGER PRIMARY KEY,
+          action       TEXT NOT NULL,
+          submitter    TEXT NOT NULL,
+          datetime     TIMESTAMP DEFAULT (strftime('%s','now')),
+          srcpath      TEXT NOT NULL,
+          comment      TEXT DEFAULT '' NOT NULL,
+          state        TEXT DEFAULT 'new');"
+    )))
+
+(define (spublish:register-action db action submitter source-path comment)
+  (exec (sql db "INSERT INTO actions (action,submitter,srcpath,comment)
+                 VALUES(?,?,?,?)")
+	action
+	submitter
+	source-path
+	comment))
+
+;; (call-with-database
+;;  (lambda (db)
+;;   (set-busy-handler! db (busy-timeout 10000)) ; 10 second timeout
+;;   ...))
+
+;; Create the sqlite db
+(define (spublish:db-do configdat proc) 
+  (let ((path (configf:lookup configdat "database" "location")))
+    (if (not path)
+	(begin
+	  (print "[database]\nlocation /some/path\n\n Is missing from the config file!")
+	  (exit 1)))
+    (if (and path
+	     (directory? path)
+	     (file-read-access? path))
+	(let* ((dbpath    (conc path "/spublish.db"))
+	       (writeable (file-write-access? dbpath))
+	       (dbexists  (file-exists? dbpath)))
+	  (handle-exceptions
+	   exn
+	   (begin
+	     (debug:print 2 "ERROR: problem accessing db " dbpath
+			  ((condition-property-accessor 'exn 'message) exn))
+	     (exit 1))
+	   (call-with-database
+            dbpath
+	    (lambda (db)
+	      ;; (print "calling proc " proc " on db " db)
+	      (set-busy-handler! db (busy-timeout 10000)) ;; 10 sec timeout
+	      (if (not dbexists)(spublish:initialize-db db))
+	      (proc db)))))
+	(print "ERROR: invalid path for storing database: " path))))
+
+;; copy in file to dest, validation is done BEFORE calling this
+;;
+(define (spublish:cp configdat submitter source-path target-dir targ-file dest-dir comment)
+  (let ((dest-dir-path (conc target-dir "/" dest-dir))
+        (targ-path (conc target-dir "/" dest-dir "/" targ-file)))
+    (if (file-exists? targ-path)
+	(begin
+	  (print "ERROR: target file already exists, remove it before re-publishing")
+	  (exit 1)))
+       (if (not(file-exists? dest-dir-path))
+	(begin
+	  (print "ERROR: target directory "  target-dir " does not exists." )
+	  (exit 1)))
+
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "cp" submitter source-path comment)))
+    (let* (;; (target-path (configf:lookup "settings" "target-path"))
+	   (th1         (make-thread
+			 (lambda ()
+			   (file-copy source-path targ-path #t))
+                            (print " ... file " targ-path " copied to" targ-path)
+			 ;; (let ((pid (process-run "cp" (list source-path target-dir))))
+			 ;;   (process-wait pid)))
+			 "copy thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+(define (spublish:validate target-dir targ-mk)
+  (let* ((normal-path (normalize-pathname targ-mk))
+        (targ-path (conc target-dir "/" normal-path)))
+    (if (string-contains   normal-path "..")
+    (begin
+      (print "ERROR: Path  " targ-mk " resolved outside target area "  target-dir )
+      (exit 1)))
+
+    (if (not (string-contains targ-path target-dir))
+    (begin
+      (print "ERROR: You cannot update data outside " target-dir ".")
+      (exit 1)))
+    (print "Path " targ-mk " is valid.")   
+ ))
+;; make directory in dest
+;;
+
+(define (spublish:mkdir configdat submitter target-dir targ-mk comment)
+  (let ((targ-path (conc target-dir "/" targ-mk)))
+    
+    (if (file-exists? targ-path)
+	(begin
+	  (print "ERROR: target Directory " targ-path " already exist!!")
+	  (exit 1)))
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "mkdir" submitter targ-mk comment)))
+    (let* ((th1         (make-thread
+			 (lambda ()
+			   (create-directory targ-path #t)
+			   (print " ... dir " targ-path " created"))
+			 "mkdir thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+;; create a symlink in dest
+;;
+(define (spublish:ln configdat submitter target-dir targ-link link-name comment)
+  (let ((targ-path (conc target-dir "/" link-name)))
+    (if (file-exists? targ-path)
+	(begin
+	  (print "ERROR: target file " targ-path " already exist!!")
+	  (exit 1)))
+     (if (not (file-exists? targ-link ))
+	(begin
+	  (print "ERROR: target file " targ-link " does not exist!!")
+	  (exit 1)))
+ 
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "ln" submitter link-name comment)))
+    (let* ((th1         (make-thread
+			 (lambda ()
+			   (create-symbolic-link targ-link targ-path  )
+			   (print " ... link " targ-path " created"))
+			 "symlink thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+
+;; remove copy of file in dest
+;;
+(define (spublish:rm configdat submitter target-dir targ-file comment)
+  (let ((targ-path (conc target-dir "/" targ-file)))
+    (if (not (file-exists? targ-path))
+	(begin
+	  (print "ERROR: target file " targ-path " not found, nothing to remove.")
+	  (exit 1)))
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "rm" submitter targ-file comment)))
+    (let* ((th1         (make-thread
+			 (lambda ()
+			   (delete-file targ-path)
+			   (print " ... file " targ-path " removed"))
+			 "rm thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+(define (spublish: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))))
+
+
+(define (spublish:lst->path pathlst)
+  (conc "/" (string-intersperse (map conc pathlst) "/")))
+
+(define (spublish:path->lst path)
+  (string-split path "/"))
+
+(define (spublish:pathdat-apply-heuristics configdat path)
+  (cond
+   ((file-exists? path) "found")
+   (else (conc path " not installed"))))
+
+;;======================================================================
+;; MISC
+;;======================================================================
+
+(define (spublish: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 (spublish:find name paths)
+  (if (null? paths)
+      #f
+      (let loop ((hed (car paths))
+		 (tal (cdr paths)))
+	(if (file-exists? (conc hed "/" name))
+	    hed
+	    (if (null? tal)
+		#f
+		(loop (car tal)(cdr tal)))))))
+
+;;======================================================================
+;; MAIN
+;;======================================================================
+
+(define (spublish:load-config exe-dir exe-name)
+  (let* ((fname   (conc exe-dir "/." exe-name ".config")))
+    (ini:property-separator-patt " *  *")
+    (ini:property-separator #\space)
+    (if (file-exists? fname)
+	;; (ini:read-ini fname)
+	(read-config fname #f #t)
+	(make-hash-table))))
+
+(define (spublish:process-action configdat action . args)
+  (let* ((target-dir    (configf:lookup configdat "settings" "target-dir"))
+	 (user          (current-user-name))
+	 (allowed-users (string-split
+			 (or (configf:lookup configdat "settings" "allowed-users")
+			     ""))))
+    (if (not target-dir)
+	(begin
+	  (print "[settings]\ntarget-dir /some/path\n\n Is MISSING from the config file!")
+	  (exit)))
+    (if (null? allowed-users)
+	(begin
+	  (print "[setings]\nallowed-users user1 user2 ...\n\n Is MISSING from the config file!")
+	  (exit)))
+    (if (not (member user allowed-users))
+	(begin
+	  (print "User \"" (current-user-name) "\" does not have access. Exiting")
+	  (exit 1)))
+    (case (string->symbol action)
+      ((cp publish)
+       (if (< (length args) 2)
+	   (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+       (let* ((remargs     (args:get-args args '("-m") '() args:arg-hash 0))
+              (dest-dir (cadr args))
+              (src-path-in (car args))
+	      (src-path    (with-input-from-pipe
+			    (conc "readlink -f " src-path-in)
+			    (lambda ()
+			      (read-line))))
+	      (msg         (or (args:get-arg "-m") ""))
+	      (targ-file   (pathname-strip-directory src-path)))
+	 (if (not (file-read-access? src-path))
+	     (begin
+	       (print "ERROR: source file not readable: " src-path)
+	       (exit 1)))
+	 (if (directory? src-path)
+	     (begin
+	       (print "ERROR: source file is a directory, this is not supported yet.")
+	       (exit 1)))
+	 (print "publishing " src-path-in " to " target-dir)
+         (spublish:validate     target-dir dest-dir)
+	 (spublish:cp configdat user src-path target-dir targ-file dest-dir msg)))
+      ((mkdir)
+        (if (< (length args) 1)
+          (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+        (let* ((targ-mk (car args))
+               (msg         (or (args:get-arg "-m") ""))) 
+               (print "attempting to create directory " targ-mk " in " target-dir)
+               (spublish:validate     target-dir targ-mk)
+               (spublish:mkdir configdat user target-dir targ-mk msg)))
+
+      ((ln) 
+        (if (< (length args) 2)
+          (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+        (let* ((targ-link (car args))
+               (link-name (cadr args))  
+               (sub-path (string-reverse (string-join (cdr (string-split (string-reverse link-name) "/")) "/"))) 
+               (msg         (or (args:get-arg "-m") "")))
+               (if(not (equal? sub-path link-name))
+                (begin 
+                  (print "attempting to create directory " sub-path " in " target-dir)
+                    (spublish:validate     target-dir sub-path)
+ 
+                  (spublish:mkdir configdat user target-dir sub-path msg)))
+
+               (print "attempting to create link " link-name " in " target-dir)
+               (spublish:ln configdat user target-dir targ-link link-name msg)))
+
+      ((rm)
+       (if (< (length args) 1)
+	   (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+       (let* ((targ-file (car args))
+	      (msg         (or (args:get-arg "-m") "")))
+	 (print "attempting to remove " targ-file " from " target-dir)
+           (spublish:validate     target-dir targ-file)
+
+	 (spublish:rm configdat user target-dir targ-file msg)))
+      ((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  (spublish: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        (spublish:open-db configdat))
+	     (versions  (spublish: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)))
+      (else (print "Unrecognised command " action)))))
+  
+;; ease debugging by loading ~/.dashboardrc - REMOVE FROM PRODUCTION!
+;; (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.spublishrc")))
+;;   (if (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)
+			(spublish:find exe-name (string-split (get-environment-variable "PATH") ":"))))
+	 (configdat (spublish: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 spublish:help))
+	((list-vars) ;; print out the ini file
+	 (map print (spublish:get-areas configdat)))
+	((ls)
+	 (let ((target-dir (configf:lookup configdat "settings" "target-dir")))
+	   (print "Files in " target-dir)
+	   (system (conc "ls " target-dir))))
+	((log)
+	 (spublish:db-do configdat (lambda (db)
+				     (print "Listing actions")
+				     (query (for-each-row
+					     (lambda (row)
+					       (apply print (intersperse row " | "))))
+					    (sql db "SELECT * FROM actions")))))
+	(else
+	 (print "ERROR: Unrecognised command. Try \"spublish help\""))))
+     ;; multi-word commands
+     ((null? rema)(print spublish:help))
+     ((>= (length rema) 2)
+      (apply spublish:process-action configdat (car rema)(cdr rema)))
+     (else (print "ERROR: Unrecognised command. Try \"spublish help\"")))))
+
+(main)

Index: sretrieve.scm
==================================================================
--- sretrieve.scm
+++ sretrieve.scm
@@ -6,63 +6,61 @@
 ;; 
 ;;  This program is distributed WITHOUT ANY WARRANTY; without even the
 ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 ;;  PURPOSE.
 
-(use ssax)
-(use sxml-serializer)
-(use sxml-modifications)
-(use regex)
-(use srfi-69)
-(use regex-case)
-(use posix)
-(use json)
-(use csv)
+(use defstruct)
+
+;; (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:))
-
+(use sql-de-lite srfi-1 posix regex regex-case srfi-69)
+;; (import (prefix sqlite3 sqlite3:))
+;; 
 (declare (uses configf))
-(declare (uses tree))
+;; (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 megatest-version))
 ;; (declare (uses tbd))
 
 (include "megatest-fossil-hash.scm")
 
 ;;
 ;; GLOBALS
 ;;
-(define *datashare:current-tab-number* 0)
+(define *spublish: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
-
-  retrieve <area> <version>           : Retrieve data as targz on STDOUT for area/version
-         options : -i iteration
+(define spublish:help (conc "Usage: spublish [action [params ...]]
+
+  ls                     : list contents of target area
+  cp|publish <src file> <relative dest>      : copy file to target area
+  mkdir <dir name>       : maks directory in target area  
+  rm <file>              : remove file <file> from target area
+  ln <target> <link name> : creates a symlink
+  log                    :
+
+  options:
+
+    -m \"message\"        : describe what was done
 
 Part of the Megatest tool suite.
 Learn more at http://www.kiatoa.com/fossils/megatest
 
 Version: " megatest-fossil-hash)) ;; "
@@ -69,625 +67,256 @@
 
 ;;======================================================================
 ;; 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)
+(define (spublish:initialize-db db)
   (for-each
    (lambda (qry)
-     (sqlite3:execute db qry))
+     (exec (sql db qry)))
    (list 
-    "CREATE TABLE pkgs 
+    "CREATE TABLE IF NOT EXISTS actions
          (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,
+          action       TEXT NOT NULL,
+          submitter    TEXT NOT NULL,
           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))
+          srcpath      TEXT NOT NULL,
+          comment      TEXT DEFAULT '' NOT NULL,
+          state        TEXT DEFAULT 'new');"
+    )))
+
+(define (spublish:register-action db action submitter source-path comment)
+  (exec (sql db "INSERT INTO actions (action,submitter,srcpath,comment)
+                 VALUES(?,?,?,?)")
+	action
+	submitter
+	source-path
+	comment))
+
+;; (call-with-database
+;;  (lambda (db)
+;;   (set-busy-handler! db (busy-timeout 10000)) ; 10 second timeout
+;;   ...))
 
 ;; Create the sqlite db
-(define (datashare:open-db configdat) 
+(define (spublish:db-do configdat proc) 
   (let ((path (configf:lookup configdat "database" "location")))
+    (if (not path)
+	(begin
+	  (print "[database]\nlocation /some/path\n\n Is missing from the config file!")
+	  (exit 1)))
     (if (and path
 	     (directory? path)
 	     (file-read-access? path))
-	(let* ((dbpath    (conc path "/datashare.db"))
+	(let* ((dbpath    (conc path "/spublish.db"))
 	       (writeable (file-write-access? dbpath))
-	       (dbexists  (file-exists? dbpath))
-	       (handler   (make-busy-timeout 136000)))
+	       (dbexists  (file-exists? dbpath)))
 	  (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 (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 (file-exists? target)(datashare:backup-move target))
-  (create-directory (pathname-directory target) #t)
-  (create-symbolic-link source target))
-
-(define (datashare:backup-move path)
+	     (exit 1))
+	   (call-with-database
+            dbpath
+	    (lambda (db)
+	      ;; (print "calling proc " proc " on db " db)
+	      (set-busy-handler! db (busy-timeout 10000)) ;; 10 sec timeout
+	      (if (not dbexists)(spublish:initialize-db db))
+	      (proc db)))))
+	(print "ERROR: invalid path for storing database: " path))))
+
+;; copy in file to dest, validation is done BEFORE calling this
+;;
+(define (spublish:cp configdat submitter source-path target-dir targ-file dest-dir comment)
+  (let ((dest-dir-path (conc target-dir "/" dest-dir))
+        (targ-path (conc target-dir "/" dest-dir "/" targ-file)))
+    (if (file-exists? targ-path)
+	(begin
+	  (print "ERROR: target file already exists, remove it before re-publishing")
+	  (exit 1)))
+       (if (not(file-exists? dest-dir-path))
+	(begin
+	  (print "ERROR: target directory "  target-dir " does not exists." )
+	  (exit 1)))
+
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "cp" submitter source-path comment)))
+    (let* (;; (target-path (configf:lookup "settings" "target-path"))
+	   (th1         (make-thread
+			 (lambda ()
+			   (file-copy source-path targ-path #t))
+                            (print " ... file " targ-path " copied to" targ-path)
+			 ;; (let ((pid (process-run "cp" (list source-path target-dir))))
+			 ;;   (process-wait pid)))
+			 "copy thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+(define (spublish:validate target-dir targ-mk)
+  (let* ((normal-path (normalize-pathname targ-mk))
+        (targ-path (conc target-dir "/" normal-path)))
+    (if (string-contains   normal-path "..")
+    (begin
+      (print "ERROR: Path  " targ-mk " resolved outside target area "  target-dir )
+      (exit 1)))
+
+    (if (not (string-contains targ-path target-dir))
+    (begin
+      (print "ERROR: You cannot update data outside " target-dir ".")
+      (exit 1)))
+    (print "Path " targ-mk " is valid.")   
+ ))
+;; make directory in dest
+;;
+
+(define (spublish:mkdir configdat submitter target-dir targ-mk comment)
+  (let ((targ-path (conc target-dir "/" targ-mk)))
+    
+    (if (file-exists? targ-path)
+	(begin
+	  (print "ERROR: target Directory " targ-path " already exist!!")
+	  (exit 1)))
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "mkdir" submitter targ-mk comment)))
+    (let* ((th1         (make-thread
+			 (lambda ()
+			   (create-directory targ-path #t)
+			   (print " ... dir " targ-path " created"))
+			 "mkdir thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+;; create a symlink in dest
+;;
+(define (spublish:ln configdat submitter target-dir targ-link link-name comment)
+  (let ((targ-path (conc target-dir "/" link-name)))
+    (if (file-exists? targ-path)
+	(begin
+	  (print "ERROR: target file " targ-path " already exist!!")
+	  (exit 1)))
+     (if (not (file-exists? targ-link ))
+	(begin
+	  (print "ERROR: target file " targ-link " does not exist!!")
+	  (exit 1)))
+ 
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "ln" submitter link-name comment)))
+    (let* ((th1         (make-thread
+			 (lambda ()
+			   (create-symbolic-link targ-link targ-path  )
+			   (print " ... link " targ-path " created"))
+			 "symlink thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+
+;; remove copy of file in dest
+;;
+(define (spublish:rm configdat submitter target-dir targ-file comment)
+  (let ((targ-path (conc target-dir "/" targ-file)))
+    (if (not (file-exists? targ-path))
+	(begin
+	  (print "ERROR: target file " targ-path " not found, nothing to remove.")
+	  (exit 1)))
+    (spublish:db-do
+     configdat
+     (lambda (db)
+       (spublish:register-action db "rm" submitter targ-file comment)))
+    (let* ((th1         (make-thread
+			 (lambda ()
+			   (delete-file targ-path)
+			   (print " ... file " targ-path " removed"))
+			 "rm thread"))
+	   (th2         (make-thread
+			 (lambda ()
+			   (let loop ()
+			     (thread-sleep! 15)
+			     (display ".")
+			     (flush-output)
+			     (loop)))
+			 "action is happening thread")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1))
+    (cons #t "Successfully saved data")))
+
+(define (spublish: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)
+
+(define (spublish:lst->path pathlst)
   (conc "/" (string-intersperse (map conc pathlst) "/")))
 
-(define (datashare:path->lst path)
+(define (spublish:path->lst path)
   (string-split path "/"))
 
-(define (datashare:pathdat-apply-heuristics configdat path)
+(define (spublish:pathdat-apply-heuristics configdat path)
   (cond
    ((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)
+(define (spublish: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)
+(define (spublish:find name paths)
   (if (null? paths)
       #f
       (let loop ((hed (car paths))
 		 (tal (cdr paths)))
 	(if (file-exists? (conc hed "/" name))
@@ -698,116 +327,182 @@
 
 ;;======================================================================
 ;; MAIN
 ;;======================================================================
 
-(define (datashare:load-config exe-dir exe-name)
+(define (spublish:load-config exe-dir exe-name)
   (let* ((fname   (conc exe-dir "/." exe-name ".config")))
     (ini:property-separator-patt " *  *")
     (ini:property-separator #\space)
     (if (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 (file-exists? debugcontrolf)
-      (load debugcontrolf)))
+(define (spublish:process-action configdat action . args)
+  (let* ((target-dir    (configf:lookup configdat "settings" "target-dir"))
+	 (user          (current-user-name))
+	 (allowed-users (string-split
+			 (or (configf:lookup configdat "settings" "allowed-users")
+			     ""))))
+    (if (not target-dir)
+	(begin
+	  (print "[settings]\ntarget-dir /some/path\n\n Is MISSING from the config file!")
+	  (exit)))
+    (if (null? allowed-users)
+	(begin
+	  (print "[setings]\nallowed-users user1 user2 ...\n\n Is MISSING from the config file!")
+	  (exit)))
+    (if (not (member user allowed-users))
+	(begin
+	  (print "User \"" (current-user-name) "\" does not have access. Exiting")
+	  (exit 1)))
+    (case (string->symbol action)
+      ((cp publish)
+       (if (< (length args) 2)
+	   (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+       (let* ((remargs     (args:get-args args '("-m") '() args:arg-hash 0))
+              (dest-dir (cadr args))
+              (src-path-in (car args))
+	      (src-path    (with-input-from-pipe
+			    (conc "readlink -f " src-path-in)
+			    (lambda ()
+			      (read-line))))
+	      (msg         (or (args:get-arg "-m") ""))
+	      (targ-file   (pathname-strip-directory src-path)))
+	 (if (not (file-read-access? src-path))
+	     (begin
+	       (print "ERROR: source file not readable: " src-path)
+	       (exit 1)))
+	 (if (directory? src-path)
+	     (begin
+	       (print "ERROR: source file is a directory, this is not supported yet.")
+	       (exit 1)))
+	 (print "publishing " src-path-in " to " target-dir)
+         (spublish:validate     target-dir dest-dir)
+	 (spublish:cp configdat user src-path target-dir targ-file dest-dir msg)))
+      ((mkdir)
+        (if (< (length args) 1)
+          (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+        (let* ((targ-mk (car args))
+               (msg         (or (args:get-arg "-m") ""))) 
+               (print "attempting to create directory " targ-mk " in " target-dir)
+               (spublish:validate     target-dir targ-mk)
+               (spublish:mkdir configdat user target-dir targ-mk msg)))
+
+      ((ln) 
+        (if (< (length args) 2)
+          (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+        (let* ((targ-link (car args))
+               (link-name (cadr args))  
+               (sub-path (string-reverse (string-join (cdr (string-split (string-reverse link-name) "/")) "/"))) 
+               (msg         (or (args:get-arg "-m") "")))
+               (if(not (equal? sub-path link-name))
+                (begin 
+                  (print "attempting to create directory " sub-path " in " target-dir)
+                    (spublish:validate     target-dir sub-path)
+ 
+                  (spublish:mkdir configdat user target-dir sub-path msg)))
+
+               (print "attempting to create link " link-name " in " target-dir)
+               (spublish:ln configdat user target-dir targ-link link-name msg)))
+
+      ((rm)
+       (if (< (length args) 1)
+	   (begin 
+	     (print "ERROR: Missing arguments; " (string-intersperse args ", "))
+	     (exit 1)))
+       (let* ((targ-file (car args))
+	      (msg         (or (args:get-arg "-m") "")))
+	 (print "attempting to remove " targ-file " from " target-dir)
+           (spublish:validate     target-dir targ-file)
+
+	 (spublish:rm configdat user target-dir targ-file msg)))
+      ((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  (spublish: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        (spublish:open-db configdat))
+	     (versions  (spublish: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)))
+      (else (print "Unrecognised command " action)))))
+  
+;; ease debugging by loading ~/.dashboardrc - REMOVE FROM PRODUCTION!
+;; (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.spublishrc")))
+;;   (if (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)))
+			(spublish:find exe-name (string-split (get-environment-variable "PATH") ":"))))
+	 (configdat (spublish: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)))
+	 (print spublish:help))
+	((list-vars) ;; print out the ini file
+	 (map print (spublish:get-areas configdat)))
+	((ls)
+	 (let ((target-dir (configf:lookup configdat "settings" "target-dir")))
+	   (print "Files in " target-dir)
+	   (system (conc "ls " target-dir))))
+	((log)
+	 (spublish:db-do configdat (lambda (db)
+				     (print "Listing actions")
+				     (query (for-each-row
+					     (lambda (row)
+					       (apply print (intersperse row " | "))))
+					    (sql db "SELECT * FROM actions")))))
 	(else
-	 (print "ERROR: Unrecognised command. Try \"datashare help\""))))
+	 (print "ERROR: Unrecognised command. Try \"spublish help\""))))
      ;; multi-word commands
-     ((null? rema)(datashare:gui configdat))
+     ((null? rema)(print spublish:help))
      ((>= (length rema) 2)
-      (apply datashare:process-action configdat (car rema)(cdr rema)))
-     (else (print "ERROR: Unrecognised command. Try \"datashare help\"")))))
+      (apply spublish:process-action configdat (car rema)(cdr rema)))
+     (else (print "ERROR: Unrecognised command. Try \"spublish help\"")))))
 
 (main)