Overview
Comment: | Access controls added to pkt generation |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65 |
Files: | files | file ages | folders |
SHA1: |
d7af4dd892b8a48a5107c4bf871d5d25 |
User & Date: | matt on 2017-06-19 23:59:18 |
Other Links: | branch diff | manifest | tags |
Context
2017-06-20
| ||
00:33 | Check access and cpu load before launching runs check-in: cdbe742d20 user: matt tags: v1.65 | |
2017-06-19
| ||
23:59 | Access controls added to pkt generation check-in: d7af4dd892 user: matt tags: v1.65 | |
22:12 | Better pkt visualizion check-in: 614169b1ac user: matt tags: v1.65 | |
Changes
Modified megatest.config from [9403028d0a] to [46981decfa].
︙ | ︙ | |||
29 30 31 32 33 34 35 | # full areas=fullrun,ext-tests; selector=MAXPATT/ # short areas=fullrun,ext-tests; selector=MAXPATT/ # all areas=fullrun,ext-tests # snazy selector=QUICKPATT/ [nopurpose] | > > > > > > > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # full areas=fullrun,ext-tests; selector=MAXPATT/ # short areas=fullrun,ext-tests; selector=MAXPATT/ # all areas=fullrun,ext-tests # snazy selector=QUICKPATT/ [nopurpose] [access] ext matt:admin mattw:owner [accesstypes] admin run rerun resume remove set-ss owner run rerun resume remove jerk set-ss |
Modified mtut.scm from [60010d18a1] to [356638346a].
︙ | ︙ | |||
963 964 965 966 967 968 969 | ((run) "runstart") ((sync) "syncstart") ;; example of translating run -> runstart (else action)) 'c (alist-ref 'o pkta) ;; THIS IS WRONG! SHOULD BE 'c 't (alist-ref 't pkta))))) (write-pkt pktsdir ack-uuid ack-pkt)))) pkts)))))) | | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 | ((run) "runstart") ((sync) "syncstart") ;; example of translating run -> runstart (else action)) 'c (alist-ref 'o pkta) ;; THIS IS WRONG! SHOULD BE 'c 't (alist-ref 't pkta))))) (write-pkt pktsdir ack-uuid ack-pkt)))) pkts)))))) (define (check-access user mtconf action area) ;; NOTE: Need control over defaults. E.g. default might be no access (let* ((access-ctrl (hash-table-exists? mtconf "access")) ;; if there is an access section the default is to REQUIRE enablement/access (access-list (map (lambda (x) (string-split x ":")) (string-split (or (configf:lookup mtconf "access" area) ;; userid:rightstype userid2:rightstype2 ... (if access-ctrl "*:none" ;; nobody has access by default "*:all"))))) (access-types-dat (configf:get-section mtconf "accesstypes"))) (debug:print 0 *default-log-port* "Checking access in " access-list " with access-ctrl " access-ctrl " for area " area) (if access-ctrl (let* ((user-access (or (assoc user access-list) (assoc "*" access-list))) (access-type (cadr user-access)) (access-types (let ((res (alist-ref access-type access-types-dat equal?))) (if res (car res) res))) (allowed-actions (string-split (or access-types "")))) (print "Got " allowed-actions " for user " user " where access-types=" access-types " access-type=" access-type) (cond ((and access-types (member action allowed-actions)) ;; (print "Access granted for " user " for " action) #t) (else ;; (print "Access denied for " user " for " action) #f)))))) (define (get-pkts-dir mtconf) (let ((pktsdirs (configf:lookup mtconf "setup" "pktsdirs")) (pktsdir (if pktsdirs (car (string-split pktsdirs " ")) #f))) pktsdir)) (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc"))) (if (common:file-exists? debugcontrolf) |
︙ | ︙ | |||
987 988 989 990 991 992 993 | (areadat (if areasec (val->alist areasec) #f)) (area-path (if areadat (alist-ref 'path areadat) #f)) (pktsdirs (configf:lookup mtconf "setup" "pktsdirs")) (pktsdir (if pktsdirs (car (string-split pktsdirs " ")) #f)) (adjargs (hash-table-copy args:arg-hash)) (new-ss (args:get-arg "-new"))) ;; check a few things | > | > > | > > > > > > | | | > | 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 | (areadat (if areasec (val->alist areasec) #f)) (area-path (if areadat (alist-ref 'path areadat) #f)) (pktsdirs (configf:lookup mtconf "setup" "pktsdirs")) (pktsdir (if pktsdirs (car (string-split pktsdirs " ")) #f)) (adjargs (hash-table-copy args:arg-hash)) (new-ss (args:get-arg "-new"))) ;; check a few things (cond ((and area (not area-path)) (print "ERROR: the specified area was not found in the [areas] table. Area name=" area) (exit 1)) ((not area) (print "ERROR: no area specified. Use -area <areaname>") (exit 1)) (else (let ((user (current-user-name))) (if (check-access user mtconf *action* area);; check rights (print "Access granted for " *action* " action by " user) (begin (print "Access denied for " *action* " action by " user) (exit 1)))))) ;; (for-each ;; (lambda (key) ;; (if (not (member key *legal-params*)) ;; (hash-table-delete! adjargs key))) ;; we need to delete any params intended for mtutil ;; (hash-table-keys adjargs)) (let-values (((uuid pkt) (command-line->pkt *action* adjargs #f area-path: area-path new-ss: new-ss))) |
︙ | ︙ |