Overview
Comment: | added a cmd to update the suid executables with the latest changes |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | pjhatwal |
Files: | files | file ages | folders |
SHA1: |
a0d2ad297216516c5e0f4aa75d04b79a |
User & Date: | pjhatwal on 2017-01-26 14:02:48 |
Original Comment: | added a cmd to update the suid exicutables with the latest changes |
Other Links: | branch diff | manifest | tags |
Context
2017-03-30
| ||
16:29 | sauth fixes to ensure user has washed appropriate unix groups check-in: 8d667887c9 user: pjhatwal tags: pjhatwal | |
2017-01-26
| ||
14:02 | added a cmd to update the suid executables with the latest changes check-in: a0d2ad2972 user: pjhatwal tags: pjhatwal | |
2017-01-23
| ||
16:30 | validated username before granting access check-in: 3585f5b63a user: pjhatwal tags: pjhatwal | |
Changes
Modified sauth-common.scm from [eb9724eec8] to [dfe4e60c87].
︙ | |||
14 15 16 17 18 19 20 | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | - + + | (dbexists (file-exists? dbpath))) (handle-exceptions exn (begin (debug:print 2 "ERROR: problem accessing db " dbpath ((condition-property-accessor 'exn 'message) exn)) (exit 1)) |
︙ |
Modified sauthorize.scm from [9810abf3b0] to [b870d922b3].
︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | + | 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 open <area code> --retrieve|--publish : update the binaries with the lates changes 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. |
︙ | |||
297 298 299 300 301 302 303 304 305 306 307 308 309 310 | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 | + + + + + + + + + + + + + + + + + + + + + + + + + + | (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:update username exe area access-type) (let* ((parts (string-split exe "_")) (owner (car parts)) (group (cadr parts)) (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 (not (equal? username owner)) (begin (print "You cannot update " area ". Only " owner " can update this area!!") (exit 1))) (copy-exe access-type exe group) (print "recording action..") (sauthorize:db-do (lambda (db) (sauthorize:db-qry db (conc "INSERT INTO actions (cmd,user_id,area_id,action_type ) VALUES ('sauthorize update " area " --" access-type "'," (car (get-user username)) "," (car (get-area area)) ", 'update' )")))) (print "Area has " area " been update!!" ))) (define (sauthorize:grant auser guser area exp-date access-type restrict) ; check if user exist in db (let* ((area-obj (get-area area)) (auser-obj (get-user auser)) (user-obj (get-user guser))) |
︙ | |||
474 475 476 477 478 479 480 481 482 483 484 485 486 487 | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | + + + + + + + + + + + + + + + + + + | (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))) ((update) (if (< (length args) 2) (begin (print "sauthorize update cmd takes 2 arguments!! \n Useage: sauthorize update <area-code> --retrieve|--publish") (exit 1))) (let* ((area (car args)) (code-obj (get-obj-by-code area)) (access-type (get-access-type (cdr args)))) (if (and (not (equal? access-type "publish")) (not (equal? access-type "retrieve"))) (begin (print "Access type can be --retrieve|--publish ") (exit 1))) (if (or (null? code-obj) (not (exe-exist (cadr code-obj) access-type))) (begin (print "Area " area " is not open for reading!!") (exit 1))) (sauthorize:update username (cadr code-obj) 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 |
︙ |
Modified spublish.scm from [6fde3f5b9e] to [fe2ed1782e].
︙ | |||
46 47 48 49 50 51 52 | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | - + + | (declare (uses megatest-version)) ;; (declare (uses tbd)) (include "megatest-fossil-hash.scm") ;;; please create this file before using sautherise. For sample file is avaliable sample-sauth-paths.scm. (include "sauth-paths.scm") (include "sauth-common.scm") |
︙ | |||
454 455 456 457 458 459 460 | 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 488 489 490 491 492 493 494 495 496 | - + + + + + - - - - - - - - - - - - + + + + + + + + + + + + + + + - - - - + + + + | "action is happening thread"))) (thread-start! th1) (thread-start! th2) (thread-join! th1) (cons #t "Successfully saved data")))) |
︙ | |||
510 511 512 513 514 515 516 517 518 519 520 521 522 523 | 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | + | ) (define (toplevel-command . args) #f) (define (spublish:shell area) ; (print area) (use readline) (let* ((path '()) (prompt "spublish> ") (args (argv)) (usr (current-user-name) ) (top-areas (spublish:get-accessable-projects area)) (close-port #f) (area-obj (get-obj-by-code area)) |
︙ | |||
616 617 618 619 620 621 622 | 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 | - + | (let*((rm-path (cadr parts)) (resolved-path (sauth-common:resolve-path rm-path path top-areas)) (target-path (sauth-common:get-target-path path rm-path top-areas base-path))) (if (not (equal? target-path #f)) (if (equal? resolved-path #f) (print "Invalid argument " rm-path ".. ") (begin |
︙ | |||
774 775 776 777 778 779 780 781 782 783 784 785 | 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 | + + - + | (if (< (length remargs) 1) (begin (print "ERROR: Missing arguments; <area> <path> ") (exit 1))) (let* ((filter-args (args:get-args args '("-m") '() args:arg-hash 0)) (rm-path (car filter-args)) (resolved-path (sauth-common:resolve-path rm-path (list area) top-areas)) (prompt ">") (iport (make-readline-port prompt)) (target-path (sauth-common:get-target-path (list area) rm-path top-areas base-path))) (if (not (equal? target-path #f)) (if (equal? resolved-path #f) (print "Invalid argument " rm-path ".. ") (begin |
︙ |