187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
(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)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
(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))
(define (sauthorize:valid-unix-user username)
(let* ((ret-val #f))
(let-values (((inp oup pid)
(process "/usr/bin/id" (list username))))
(let loop ((inl (read-line inp)))
(if (string? inl)
(if (string-contains inl "No such user")
(set! ret-val #f)
(set! ret-val #t)))
(if (eof-object? inl)
(begin
(close-input-port inp)
(close-output-port oup))
(loop (read-line inp)))))
ret-val))
;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)
|
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
(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)
; check if user exist
(let* ((area-obj (get-area area))
(auser-obj (get-user auser))
(user-obj (get-user guser)))
(if (null? user-obj)
(begin
(sauthorize:db-do (lambda (db)
(sauthorize:db-qry db (conc "insert into users (username, is_admin) values ('" guser "', 'no') "))))
(set! user-obj (get-user guser))))
(let* ((perm-obj (get-perm (car user-obj) (car area-obj))))
(if(null? perm-obj)
(begin
;; insert permissions
|
|
>
>
>
>
>
|
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
|
(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)
; check if user exist in db
(let* ((area-obj (get-area area))
(auser-obj (get-user auser))
(user-obj (get-user guser)))
(if (null? user-obj)
(begin
;; is guser a valid unix user
(if (not (sauthorize:valid-unix-user guser))
(begin
(print "User " guser " is Invalid unix user!!")
(exit 1)))
(sauthorize:db-do (lambda (db)
(sauthorize:db-qry db (conc "insert into users (username, is_admin) values ('" guser "', 'no') "))))
(set! user-obj (get-user guser))))
(let* ((perm-obj (get-perm (car user-obj) (car area-obj))))
(if(null? perm-obj)
(begin
;; insert permissions
|