@@ -111,42 +111,36 @@ "publish") ((equal? hed "--area-admin") "area-admin") ((equal? hed "--writer-admin") "writer-admin") + ((equal? hed "--read-admin") + "read-admin") + ((null? tal) #f) (else (loop (car tal)(cdr tal)))))) -(define (is-access-valid exp-str) - (let* ((ret-val #f ) - (date-parts (string-split exp-str "/")) - (yr (string->number (car date-parts))) - (month (string->number(car (cdr date-parts)))) - (day (string->number(caddr date-parts))) - (exp-date (make-date 0 0 0 0 day month yr ))) - ;(print exp-date) - ;(print (current-date)) - (if (> (date-compare exp-date (current-date)) 0) - (set! ret-val #t)) - ;(print ret-val) - ret-val)) ;; check if user can gran access to an area (define (can-grant-perm username access-type area) (let* ((isadmin (is-admin username)) (is-area-admin (is-user "area-admin" username area )) + (is-read-admin (is-user "read-admin" username area) ) (is-writer-admin (is-user "writer-admin" username area) ) ) (cond ((equal? isadmin #t) #t) ((equal? is-area-admin #t ) #t) ((and (equal? is-writer-admin #t ) (equal? access-type "retrieve")) #t) + ((and (equal? is-read-admin #t ) (equal? access-type "retrieve")) + #t) + (else #f)))) (define (sauthorize:list-areausers area ) (sauthorize:db-do (lambda (db) @@ -157,27 +151,10 @@ (if (is-access-valid exp-date) (apply print (intersperse row " | ")))))) (sql db (conc "SELECT users.username, permissions.expiration, permissions.access_type FROM users, areas, permissions where permissions.user_id = users.id and permissions.area_id = areas.id and areas.code = '" area "'")))))) - - - -(define (get-obj-by-path path) - (let* ((obj '())) - (sauthorize:db-do (lambda (db) - (let* ((data-row (query fetch (sql db (conc "SELECT code,exe_name, id, basepath FROM areas where areas.basepath = '" path "'"))))) - (set! obj data-row)))) -obj)) - -(define (get-obj-by-code code ) - (let* ((obj '())) - (sauthorize:db-do (lambda (db) - (let* ((data-row (query fetch (sql db (conc "SELECT code, exe_name, id, basepath FROM areas where areas.code = '" code "'"))))) - (set! obj data-row)))) -obj)) - ; check if executable exists (define (exe-exist exe access-type) (let* ((filepath (conc *exe-path* "/" access-type "/" exe))) @@ -191,12 +168,16 @@ (let* ((spath (conc *exe-src* "/s" access-type)) (dpath (conc *exe-path* "/" access-type "/" exe-name))) (sauthorize:do-as-calling-user (lambda () (run-cmd "/bin/cp" (list spath dpath )) - (run-cmd "/bin/chgrp" (list group dpath)) - (run-cmd "/bin/chmod" (list "u+s,g+s" dpath)))) + (if (equal? access-type "publish") + (run-cmd "/bin/chmod" (list "u+s,o+rx" dpath)) + (begin + (run-cmd "/bin/chgrp" (list group dpath)) + (run-cmd "/bin/chmod" (list "g+s,o+rx" dpath)))) +)) (run-cmd "chmod" (list "g-w" (conc *exe-path* "/" access-type))))) (define (get-exe-name path group) (let ((name "")) (sauthorize:do-as-calling-user @@ -242,26 +223,22 @@ (if (not (exe-exist exe-name access-type)) (copy-exe access-type exe-name group)) (sauthorize:db-do (lambda (db) (sauthorize:db-qry db (conc "insert into areas (code, basepath, exe_name) values ('" code "', '" path "', '" exe-name "') ")))))))) -(define (user-has-open-perm user path) +(define (user-has-open-perm user path access) (let* ((has-access #f) (eid (current-user-id))) (cond ((is-admin user) + (set! has-access #t )) + ((and (is-read-admin user) (equal? access "retrieve")) (set! has-access #t )) (else (print "User " user " does not have permission to open areas"))) has-access)) -(define (run-cmd cmd arg-list) - (handle-exceptions - exn - (debug:print 0 "ERROR: failed to run script " conversion-script " with params " upstream-file " " package-config) - (let ((pid (process-run cmd arg-list))) - (process-wait pid)))) ;;check if user has group access (define (is-group-washed req_grpid current-grp-list) (let loop ((hed (car current-grp-list)) (tal (cdr current-grp-list))) @@ -284,13 +261,14 @@ (exit 1)))) (if (not (file-write-access? path)) (begin (print "You can open areas owned by yourself. You do not have permissions to open path." path) (exit 1))) - (if (user-has-open-perm user path) + (if (user-has-open-perm user path access-type) (begin (open-area group path code access-type) + (sauthorize:grant user user code "2017/12/25" "read-admin" "") (sauthorize:db-do (lambda (db) (sauthorize:db-qry db (conc "INSERT INTO actions (cmd,user_id,area_id,action_type ) VALUES ('sauthorize open " path " --code " code " --group " group " --" access-type "'," (car (get-user user)) "," (car (get-area code)) ", 'open' )")))) (print "Area has " path " been opened for " access-type )))) (define (sauthorize:grant auser guser area exp-date access-type restrict) @@ -314,11 +292,11 @@ ;update permissions (sauthorize:db-do (lambda (db) (sauthorize:db-qry db (conc "update permissions set access_type = '" access-type "' , restriction = '" restrict "', expiration = '" exp-date "' where user_id = " (car user-obj) " and area_id = " (car area-obj))))))) (sauthorize:db-do (lambda (db) (sauthorize:db-qry db (conc "INSERT INTO actions (cmd,user_id,area_id,action_type ) VALUES ('sauthorize grant " guser " --area " area " --expiration " exp-date " --" access-type " --restrict " restrict "'," (car auser-obj) "," (car area-obj) ", 'grant' )")))) - (print "Permission has been sucessfully granted to user " guser) ))) + (print "Permission has been sucessfully granted to user " guser)))) (define (sauthorize:process-action username action . args) (case (string->symbol action) ((grant) (if (< (length args) 6) @@ -365,13 +343,13 @@ (let* ((area (car args))) (if (not (area-exists area)) (begin (print "Area does not exisit!!") (exit 1))) - (if (can-grant-perm username "retrieve" area) - (sauthorize:list-areausers area ) - (print "User does not have access to run this cmd!")))) + + (sauthorize:list-areausers area ) + )) ((read-shell) (if (not (equal? (length args) 1)) (begin (print "Missing argument area code to read-shell ") (exit 1))) @@ -382,11 +360,11 @@ (begin (print "Area " area " is not open for reading!!") (exit 1))) (sauthorize:do-as-calling-user (lambda () - (run-cmd (conc *exe-path* "/retrieve/" (cadr code-obj) ) (list "shell" )))))) + (run-cmd (conc *exe-path* "/retrieve/" (cadr code-obj) ) (list "shell" area )))))) ((write-shell) (if (not (equal? (length args) 1)) (begin (print "Missing argument area code to read-shell ") (exit 1))) @@ -397,11 +375,11 @@ (begin (print "Area " area " is not open for reading!!") (exit 1))) (sauthorize:do-as-calling-user (lambda () - (run-cmd (conc *exe-path* "/publish/" (cadr code-obj) ) (list "shell" )))))) + (run-cmd (conc *exe-path* "/publish/" (cadr code-obj) ) (list "shell" area)))))) ((open) (if (< (length args) 6) (begin @@ -420,17 +398,36 @@ (print "--code not found!! Try \"sauthorize help\" for useage ") (exit 1)) ((equal? access-type #f) (print "Access type not found!! Try \"sauthorize help\" for useage ") (exit 1)) - ((or (equal? access-type "area-admin") - (equal? access-type "writer-admin")) + ((and (not (equal? access-type "publish")) + (not (equal? access-type "retrieve"))) (print "Access type can be eiter --retrieve or --publish !! Try \"sauthorize help\" for useage ") (exit 1))) - (sauthorize:open username path group area access-type))) - (else (debug:print 0 "Unrecognised command " action)))) + (sauthorize:open username path group area access-type))) + ((register-log) + (if (< (length args) 4) + (print "Invalid arguments")) + ;(print args) + (let* ((cmd-line (car args)) + (user-id (cadr args)) + (area-id (caddr args)) + (user-obj (get-user username)) + (cmd (cadddr args))) + + (if (and (not (null? user-obj)) (equal? user-id (number->string(car user-obj)))) + (begin + (sauthorize:db-do (lambda (db) + (sauthorize:db-qry db (conc "INSERT INTO actions (cmd,user_id,area_id,action_type ) VALUES ('" cmd-line"', " user-id "," area-id ", '" cmd "')" ))))) + (print "You ar not authorised to run this cmd") + +))) + + + (else (print 0 "Unrecognised command " action)))) (define (main) (let* ((args (argv)) (prog (car args)) (rema (cdr args))