Index: sample-sauth-paths.scm ================================================================== --- sample-sauth-paths.scm +++ sample-sauth-paths.scm @@ -1,4 +1,5 @@ (define *db-path* "/path/to/db") (define *exe-path* "/path/to/store/suids") (define *exe-src* "/path/to/spublish/and/sretrieve/executables") (define *sauth-path* "/path/to/production/sauthorize/exe") +(define *super-users* '("user1" "user2")) Index: sauth-common.scm ================================================================== --- sauth-common.scm +++ sauth-common.scm @@ -185,12 +185,15 @@ obj)) (define (get-obj-by-code code ) (let* ((obj '())) (sauthorize:db-do (lambda (db) + ;(print (conc "SELECT code, exe_name, id, basepath, required_grps FROM areas where areas.code = '" code "'")) (let* ((data-row (query fetch (sql db (conc "SELECT code, exe_name, id, basepath, required_grps FROM areas where areas.code = '" code "'"))))) + ;(print data-row) (set! obj data-row) + ;(print obj) ))) (if (not (null? obj)) (begin (let* ((req-grp (caddr (cddr obj)))) (sauthorize:do-as-calling-user Index: sauthorize.scm ================================================================== --- sauthorize.scm +++ sauthorize.scm @@ -445,14 +445,18 @@ ((publish) (if (< (length args) 2) (begin (print "Missing argument to publish. \n publish [opts] ") (exit 1))) + (let* ((action (car args)) (area (cadr args)) (cmd-args (cddr args)) (code-obj (get-obj-by-code area))) + ;(print "area " area) + ;(print "code: " code-obj) + ;(print (exe-exist (cadr code-obj) "publish")) (if (or (null? code-obj) (not (exe-exist (cadr code-obj) "publish"))) (begin (print "Area " area " is not open for writing!!") (exit 1))) @@ -548,10 +552,32 @@ (sauthorize:db-qry db (conc "update users set is_admin = 'read-admin' where id = " (car usr-obj))))))) (print "User " usr " is updated with area-admin access!")) (print "Admin only function")) (sauthorize:db-do (lambda (db) (sauthorize:db-qry db (conc "INSERT INTO actions (cmd,user_id,area_id,action_type ) VALUES ('area-admin " usr " ', " user-id ",0, 'area-admin ')" )))))) + ((mk-admin) + (let* ((usr (car args)) + (usr-obj (get-user usr)) + (user-id (car (get-user username)))) + (if (not (sauthorize:valid-unix-user usr)) + (begin + (print "User " usr " is Invalid unix user!!") + (exit 1))) + + (if (member username *super-users*) + (begin + (if (null? usr-obj) + (begin + (sauthorize:db-do (lambda (db) + (sauthorize:db-qry db (conc "INSERT INTO users (username,is_admin) VALUES ( '" usr "', 'yes' )"))))) + (begin + (sauthorize:db-do (lambda (db) + (sauthorize:db-qry db (conc "update users set is_admin = 'yes' where id = " (car usr-obj))))))) + (print "User " usr " is updated with admin access!")) + (print "Super-Admin only function")) + (sauthorize:db-do (lambda (db) + (sauthorize:db-qry db (conc "INSERT INTO actions (cmd,user_id,area_id,action_type ) VALUES ('mk-admin " usr " ', " user-id ",0, 'mk-admin ')" )))))) ((register-log) (if (< (length args) 4) (print "Invalid arguments")) ;(print args) Index: spublish.scm ================================================================== --- spublish.scm +++ spublish.scm @@ -381,13 +381,13 @@ ;; shell functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (spublish:shell-cp src-path target-path) (cond ((not (file-exists? target-path)) - (print "ERROR: target Directory " target-path " does not exist!!")) + (sauth:print-error (conc " target Directory " target-path " does not exist!!"))) ((not (file-exists? src-path)) - (print "Error: Source path " src-path " does not exist!!" )) + (sauth:print-error (conc "Source path " src-path " does not exist!!" ))) (else (if (is_directory src-path) (begin (let* ((parent-dir src-path) (start-dir target-path)) @@ -412,11 +412,11 @@ (define (spublish:shell-mkdir targ-path) (if (file-exists? targ-path) (begin - (print "ERROR: target Directory " targ-path " already exist!!")) + (print "Info: Target Directory " targ-path " already exist!!")) (let* ((th1 (make-thread (lambda () (create-directory targ-path #t) (print " ... dir " targ-path " created")) "mkdir thread")) @@ -435,20 +435,22 @@ (define (spublish:shell-rm targ-path iport) (if (not (file-exists? targ-path)) (begin - (print "ERROR: target path " targ-path " does not exist!!")) + (sauth:print-error (conc "target path " targ-path " does not exist!!"))) (begin (print "Are you sure you want to delete " targ-path "?[y/n]") (let* ((inl (read-line iport))) (if (equal? inl "y") (let* ((th1 (make-thread (lambda () - (if (directory? targ-path) - (delete-directory targ-path #t) - (delete-file targ-path )) + (if (symbolic-link? targ-path) + (delete-file targ-path ) + (if (directory? targ-path) + (delete-directory targ-path #t) + (delete-file targ-path ))) (print " ... path " targ-path " deleted")) "rm thread")) (th2 (make-thread (lambda () (let loop () @@ -462,17 +464,17 @@ (thread-join! th1) (cons #t "Successfully saved data"))))))) (define (spublish:shell-ln src-path target-path sub-path) (if (not (file-exists? sub-path)) - (print "ERROR: Path " sub-path " does not exist!! cannot proceed with link creation!!") + (sauth:print-error (conc "Path " sub-path " does not exist!! cannot proceed with link creation!!")) (begin (if (not (file-exists? src-path)) - (print "ERROR: Path " src-path " does not exist!! cannot proceed with link creation!!") + (sauth:print-error (conc "Path " src-path " does not exist!! cannot proceed with link creation!!")) (begin (if (file-exists? target-path) - (print "ERROR: Path " target-path "already exist!! cannot proceed with link creation!!") + (sauth:print-error (conc "Path " target-path "already exist!! cannot proceed with link creation!!")) (begin (create-symbolic-link src-path target-path ) (print " ... link " target-path " created")))))))) (define (spublish:shell-help) Index: sretrieve.scm ================================================================== --- sretrieve.scm +++ sretrieve.scm @@ -522,11 +522,11 @@ (else (loop (car tal)(cdr tal)(conc ret-str ".+" hed ".*|")))))) ) (define (sretrieve:get-shell-cmd target-path base-path restrictions iport) (if (not (file-exists? target-path)) - (print "Target path does not exist!") + (sauth:print-error "Target path does not exist!") (begin (if (not (equal? target-path #f)) (begin (if (is_directory target-path) (begin @@ -614,11 +614,11 @@ (sauth:print-error (conc "Problem fetching the data. Sauth provieds sudo access to only one unix group. Please ensure you have washed all the remaining groups. System Error: " ((condition-property-accessor 'exn 'message) exn))) (exit 1)) (if (not (file-exists? target-path)) - (print "Error:Target path does not exist!") + (sauth:print-error "Error:Target path does not exist!") (begin (if (not (equal? target-path #f)) (begin (if (is_directory target-path) (begin @@ -630,12 +630,12 @@ (start-dir (conc (current-directory) "/" last-dir-name)) (execlude (make-exclude-pattern (string-split restrictions ","))) (tmpfile (conc "/tmp/" (current-user-name) "/my-pipe-" (current-process-id)))) (if (file-exists? start-dir) (begin - (print last-dir-name " already exist in your work dir.") - (print "Nothing has been retrieved!! ")) + (sauth:print-error (conclast-dir-name " already exist in your work dir.")) + (sauth:print-error "Nothing has been retrieved!! ")) (begin ; (sretrieve:do-as-calling-user ; (lambda () (if (not (file-exists? (conc "/tmp/" (current-user-name)))) @@ -910,11 +910,11 @@ ; (use readline) (case (string->symbol action) ((get) (if (< (length args) 2) (begin - (print "ERROR: Missing arguments; " ) + (sauth:print-error "Missing arguments; " ) (exit 1))) (let* ((remargs (args:get-args args '("-m" ) '() args:arg-hash 0)) (iport (make-readline-port ">")) (area (car args)) (usr (current-user-name)) @@ -928,11 +928,11 @@ "" (car remargs)))) (if (null? area-obj) (begin - (print "Area " area " does not exist") + (sauth:print-error (conc "Area " area " does not exist")) (exit 1))) (let* ((target-path (sauth-common:get-target-path '() (conc area "/" sub-path) top-areas base-path)) (restrictions (if (equal? target-path #f) "" (sretrieve:shell-lookup base-path)))) @@ -943,11 +943,11 @@ (run-cmd (conc *sauth-path* "/sauthorize") (list "register-log" (conc "get " area " " sub-path) (number->string (car user-obj)) (number->string (caddr area-obj)) "get")))) (sretrieve:get-shell-cmd-line target-path base-path restrictions iport)))))) ((cp) (if (< (length args) 2) (begin - (print "ERROR: Missing arguments; " ) + (sauth:print-error "Missing arguments; " ) (exit 1))) (let* ((remargs (args:get-args args '("-m" ) '() args:arg-hash 0)) (iport (make-readline-port ">")) (area (car args)) (usr (current-user-name)) @@ -961,11 +961,11 @@ "" (car remargs)))) ; (print args) (if (null? area-obj) (begin - (print "Area " area " does not exist") + (sauth:print-error (conc "Area " area " does not exist")) (exit 1))) (let* ((target-path (sauth-common:get-target-path '() (conc area "/" sub-path) top-areas base-path)) (restrictions (if (equal? target-path #f) "" (sretrieve:shell-lookup base-path))))