| ︙ | | | ︙ | |
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
(define *exe-name* (pathname-file (car (argv))))
(define *sretrieve:current-tab-number* 0)
(define *args-hash* (make-hash-table))
(define sauthorize:help (conc "Usage: " *exe-name* " [action [params ...]]
list : list areas $USER's can access
log : get listing of recent activity.
sauthorize list-area-user <area code> : list the users that can access the area.
sauthorize open <path> --group <grpname> : Open up an area. User needs to be the owner of the area to open it.
--code <unique short identifier for an area>
--retrieve|--publish
sauthorize grant <username> --area <area identifier> : Grant permission to read or write to a area that is alrady opend up.
--expiration yyyy/mm/dd --retrieve|--publish
[--restrict <comma separated directory names> ]
sauthorize read-shell <area identifier> : Open sretrieve shell for reading.
sauthorize write-shell <area identifier> : Open spublish shell for writing.
Part of the Megatest tool suite.
Learn more at http://www.kiatoa.com/fossils/megatest
Version: " megatest-fossil-hash)) ;; "
;;======================================================================
;; RECORDS
|
|
|
|
|
|
>
|
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
(define *exe-name* (pathname-file (car (argv))))
(define *sretrieve:current-tab-number* 0)
(define *args-hash* (make-hash-table))
(define sauthorize:help (conc "Usage: " *exe-name* " [action [params ...]]
list : list areas $USER's can access
log : get listing of recent activity.
sauth list-area-user <area code> : list the users that can access the area.
sauth open <path> --group <grpname> : Open up an area. User needs to be the owner of the area to open it.
--code <unique short identifier for an area>
--retrieve|--publish
sauth grant <username> --area <area identifier> : Grant permission to read or write to a area that is alrady opend up.
--expiration yyyy/mm/dd --retrieve|--publish
[--restrict <comma separated directory names> ]
sauth read-shell <area identifier> : Open sretrieve shell for reading.
sauth write-shell <area identifier> : Open spublish shell for writing.
Part of the Megatest tool suite.
Learn more at http://www.kiatoa.com/fossils/megatest
Version: " megatest-fossil-hash)) ;; "
;;======================================================================
;; RECORDS
|
| ︙ | | | ︙ | |
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
(dpath (conc *exe-path* "/" access-type "/" exe-name)))
(sauthorize:do-as-calling-user
(lambda ()
(run-cmd "/bin/cp" (list spath 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
(lambda ()
(if (equal? (current-effective-user-id) (file-owner path))
(set! name (conc (current-user-name) "_" group))
(begin
(print "You cannot open areas that you dont own!!")
(exit 1)))))
name))
;check if a paths/codes are vaid and if area is alrady open
(define (open-area group path code access-type)
(let* ((exe-name (get-exe-name path group))
(path-obj (get-obj-by-path path))
(code-obj (get-obj-by-code code)))
(cond
((not (null? path-obj))
(if (equal? code (car path-obj))
(begin
(if (equal? exe-name (cadr path-obj))
(begin
(if (not (exe-exist exe-name access-type))
|
>
>
>
|
|
<
|
>
|
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
(dpath (conc *exe-path* "/" access-type "/" exe-name)))
(sauthorize:do-as-calling-user
(lambda ()
(run-cmd "/bin/cp" (list spath dpath ))
(if (equal? access-type "publish")
(run-cmd "/bin/chmod" (list "u+s,o+rx" dpath))
(begin
(if (equal? group "none")
(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
(lambda ()
(if (equal? (current-effective-user-id) (file-owner path))
(set! name (conc (current-user-name) "_" group))
(begin
(print "You cannot open areas that you dont own!!")
(exit 1)))))
name))
;check if a paths/codes are vaid and if area is alrady open
(define (open-area group path code access-type)
(let* ((exe-name (get-exe-name path group))
(path-obj (get-obj-by-path path))
(code-obj (get-obj-by-code code)))
;(print path-obj)
(cond
((not (null? path-obj))
(if (equal? code (car path-obj))
(begin
(if (equal? exe-name (cadr path-obj))
(begin
(if (not (exe-exist exe-name access-type))
|
| ︙ | | | ︙ | |
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
(print "Path " path " is registered with --code " (car path-obj) ". To open this area please execute following cmd: \n sauthorize open " path " --group " group " --code " (car path-obj) " --" access-type )
(exit 1))))
((not (null? code-obj))
(print "Code " code " is used for diffrent path. Please try diffrent value of --code" )
(exit 1))
(else
(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 access)
(let* ((has-access #f)
(eid (current-user-id)))
(cond
((is-admin user)
|
>
>
|
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
(print "Path " path " is registered with --code " (car path-obj) ". To open this area please execute following cmd: \n sauthorize open " path " --group " group " --code " (car path-obj) " --" access-type )
(exit 1))))
((not (null? code-obj))
(print "Code " code " is used for diffrent path. Please try diffrent value of --code" )
(exit 1))
(else
; (print (exe-exist exe-name access-type))
(if (not (exe-exist exe-name access-type))
(copy-exe access-type exe-name group))
(sauthorize:db-do (lambda (db)
;(print (conc "insert into areas (code, basepath, exe_name) values ('" code "', '" path "', '" exe-name "') "))
(sauthorize:db-qry db (conc "insert into areas (code, basepath, exe_name) values ('" code "', '" path "', '" exe-name "') "))))))))
(define (user-has-open-perm user path access)
(let* ((has-access #f)
(eid (current-user-id)))
(cond
((is-admin user)
|
| ︙ | | | ︙ | |
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
|
((null? tal)
#f)
(else
(loop (car tal)(cdr tal))))))
;create executables with appropriate suids
(define (sauthorize:open user path group code access-type)
(let* ((req_grpid (caddr (group-information group)))
(current-grp-list (get-groups))
(valid-grp (is-group-washed req_grpid current-grp-list)))
(if (equal? valid-grp #f )
(begin
(print "Group " group " is not washed in the current xterm!!")
(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 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)
|
|
>
>
>
>
>
>
>
|
|
|
>
|
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
|
((null? tal)
#f)
(else
(loop (car tal)(cdr tal))))))
;create executables with appropriate suids
(define (sauthorize:open user path group code access-type)
(let* ((gpid (group-information group))
(req_grpid (if (equal? group "none")
group
(if (equal? gpid #f)
#f
(caddr gpid))))
(current-grp-list (get-groups))
(valid-grp (if (equal? group "none")
group
(is-group-washed req_grpid current-grp-list))))
(if (and (not (equal? group "none")) (equal? valid-grp #f ))
(begin
(print "Group " group " is not washed in the current xterm!!")
(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 access-type)
(begin
;(print "here")
(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)
|
| ︙ | | | ︙ | |
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
|
(print "Missing argument area code to read-shell ")
(exit 1)))
(let* ((area (car args))
(code-obj (get-obj-by-code area)))
(if (or (null? code-obj)
(not (exe-exist (cadr code-obj) "publish")))
(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" area))))))
((open)
(if (< (length args) 6)
(begin
(print "sauthorize open cmd takes 6 arguments!! \n Useage: sauthorize open <path> --group <grpname> --code <unique short identifier for an area> --retrieve|--publish")
(exit 1)))
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
|
(print "Missing argument area code to read-shell ")
(exit 1)))
(let* ((area (car args))
(code-obj (get-obj-by-code area)))
(if (or (null? code-obj)
(not (exe-exist (cadr code-obj) "publish")))
(begin
(print "Area " area " is not open for Writing!!")
(exit 1)))
(sauthorize:do-as-calling-user
(lambda ()
(run-cmd (conc *exe-path* "/publish/" (cadr code-obj) ) (list "shell" area))))))
((publish)
(if (< (length args) 2)
(begin
(print "Missing argument to publish. \n publish <action> <area> [opts] ")
(exit 1)))
(let* ((action (car args))
(area (cadr args))
(cmd-args (cddr args))
(code-obj (get-obj-by-code area)))
(if (or (null? code-obj)
(not (exe-exist (cadr code-obj) "publish")))
(begin
(print "Area " area " is not open for writing!!")
(exit 1)))
(sauthorize:do-as-calling-user
(lambda ()
(run-cmd (conc *exe-path* "/publish/" (cadr code-obj) ) (append (list action area ) cmd-args))))))
((retrieve)
(if (< (length args) 2)
(begin
(print "Missing argument to publish. \n publish <action> <area> [opts] ")
(exit 1)))
(let* ((action (car args))
(area (cadr args))
(cmd-args (cddr args))
(code-obj (get-obj-by-code area)))
(if (or (null? code-obj)
(not (exe-exist (cadr code-obj) "retrieve")))
(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) ) (append (list action area ) cmd-args))))))
((open)
(if (< (length args) 6)
(begin
(print "sauthorize open cmd takes 6 arguments!! \n Useage: sauthorize open <path> --group <grpname> --code <unique short identifier for an area> --retrieve|--publish")
(exit 1)))
|
| ︙ | | | ︙ | |
402
403
404
405
406
407
408
409
410
411
412
413
414
415
|
(exit 1))
((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)))
((register-log)
(if (< (length args) 4)
(print "Invalid arguments"))
;(print args)
(let* ((cmd-line (car args))
(user-id (cadr args))
(area-id (caddr args))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
|
(exit 1))
((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)))
((area-admin)
(let* ((usr (car args))
(usr-obj (get-user usr))
(user-id (car (get-user username))))
(if (is-admin username)
(begin
; (print usr-obj)
(if (null? usr-obj)
(begin
(sauthorize:db-do (lambda (db)
;(print (conc "INSERT INTO users (username,is_admin) VALUES ( '" usr "', 'read-admin' )"))
(sauthorize:db-qry db (conc "INSERT INTO users (username,is_admin) VALUES ( '" usr "', 'read-admin' )")))))
(begin
; (print (conc "update users set is_admin = 'no' where id = " (car usr-obj) ))
(sauthorize:db-do (lambda (db)
(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 ')" ))))))
((register-log)
(if (< (length args) 4)
(print "Invalid arguments"))
;(print args)
(let* ((cmd-line (car args))
(user-id (cadr args))
(area-id (caddr args))
|
| ︙ | | | ︙ | |
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
|
(sauthorize:db-do (lambda (db)
(print "My Area accesses: ")
(query (for-each-row
(lambda (row)
(let* ((exp-date (car row)))
(if (is-access-valid exp-date)
(apply print (intersperse (cdr row) " | "))))))
(sql db (conc "SELECT permissions.expiration, areas.basepath, areas.code, permissions.access_type FROM users, areas, permissions where permissions.user_id = users.id and permissions.area_id = areas.id and users.username = '" username "'")))))
)
((log)
(sauthorize:db-do (lambda (db)
(print "Logs : ")
(query (for-each-row
(lambda (row)
(apply print (intersperse row " | "))))
|
|
|
|
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
|
(sauthorize:db-do (lambda (db)
(print "My Area accesses: ")
(query (for-each-row
(lambda (row)
(let* ((exp-date (car row)))
(if (is-access-valid exp-date)
(apply print (intersperse (cdr row) " | "))))))
(sql db (conc "SELECT permissions.expiration, areas.basepath, areas.code, permissions.access_type FROM users, areas, permissions where permissions.user_id = users.id and permissions.area_id = areas.id and users.username = '" username "'"))))))
((log)
(sauthorize:db-do (lambda (db)
(print "Logs : ")
(query (for-each-row
(lambda (row)
(apply print (intersperse row " | "))))
|
| ︙ | | | ︙ | |