Index: datashare.scm
==================================================================
--- datashare.scm
+++ datashare.scm
@@ -31,12 +31,12 @@
 (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 margs))
 ;; (declare (uses launch))
 ;; (declare (uses gutils))
 ;; (declare (uses db))
 ;; (declare (uses synchash))
 ;; (declare (uses server))
@@ -47,14 +47,17 @@
 
 ;;
 ;; 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>
   publish <path> <area> <version>     : Publish data to share, use group to protect
   get <area> <version>                : Get a link to data, put the link in destpath (i)
   update <area>                       : Update the link to data to the latest iteration.
 
 (i) Uses local path or looks up script to find path in configs
@@ -259,10 +262,22 @@
      (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-versions-for-area db area-name #!key (version-patt "%"))
+  (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;"
+     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)
@@ -288,27 +303,38 @@
 	  (print "ERROR: Not enough space in storage area " dest-path)
 	  (datashare:set-copied db id "no")
 	  (sqlite3:finalize! db)
 	  #f))))
 
-(define (datashare:publish area-name version comment spath submitter quality)
-  (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)))
+(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)
@@ -401,11 +427,11 @@
 			       (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 area-name version comment spath submitter quality))))
+			  (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"
@@ -600,10 +626,21 @@
 
 ;;======================================================================
 ;; 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)))
@@ -624,22 +661,62 @@
     (if (file-exists? fname)
 	;; (ini:read-ini fname)
 	(read-config fname #f #t)
 	(make-hash-table))))
 
-(define (datashare:process-action configdat action args)
+(define (datashare:process-action configdat action . args)
   (case (string->symbol action)
     ((publish)
      (if (< (length args) 3)
 	 (begin 
 	   (print "ERROR: Missing arguments; " (string-intersperse args ", "))
-	   (exit))
+	   (exit 1))
 	 (let* ((srcpath  (list-ref args 0))
 		(areaname (list-ref args 1))
 		(version  (list-ref args 2))
-		(remargs  (drop args 3)))
-	   (datashare:import-data configdat srcpath dest-path area version iteration))))))
+		(remargs  (args:get-args (drop args 3)
+					 '("-type" ;; link or copy (default is copy)
+					   "-m")
+ 					 '()
+ 					 args:arg-hash
+ 					 0))
+		(publish-type (if (equal? (args:get-arg "-type") "link") 'link 'copy))
+		(comment      (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)))))
+;; use for get
+
+;; 		(remargs  (args:get-args (drop args 3)
+;; 					 '("-i") ;; iteration
+;; 					 '()
+;; 					 *args-hash*
+;; 					 0))
+;; 		;; if -i specified use it as a number, default to -1 which is use highest iteration
+;; 		(iteration (if (args:get-arg "-i")(string->number (args:get-arg "-i")) -1)))
 
 ;; ease debugging by loading ~/.dashboardrc - remove from production!
 (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.datasharerc")))
   (if (file-exists? debugcontrolf)
       (load debugcontrolf)))
@@ -651,17 +728,21 @@
 	 (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)