238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
(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))))
;(print obj)
obj))
;; function to validate the users input for target path and resolve the path
;; TODO: Check for restriction in subpath
(define (sauth-common:resolve-path new current allowed-sheets)
(let* ((target-path (append current (string-split new "/")))
(target-path-string (string-join target-path "/"))
|
>
>
>
>
>
>
>
>
>
>
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
(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))))
;(print obj)
obj))
(define (sauth-common:src-size path)
(let ((output (with-input-from-pipe (conc "/usr/bin/du -s " path " | awk '{print $1}'")
(lambda()
(read-line)))))
(string->number output)))
(define (sauth-common:space-left-at-dest path)
(let* ((output (run/string (pipe (df ,path ) (tail -1))))
(size (caddr (string-split output " "))))
(string->number size)))
;; function to validate the users input for target path and resolve the path
;; TODO: Check for restriction in subpath
(define (sauth-common:resolve-path new current allowed-sheets)
(let* ((target-path (append current (string-split new "/")))
(target-path-string (string-join target-path "/"))
|
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
|
base-path
(conc base-path "/" (string-join (cdr resolved-path) "/")))))
(if (and (not (equal? restricted-areas "" ))
(string-match (regexp restrictions) target-path))
(begin
(sauth:print-error "Access denied to " (string-join resolved-path "/"))
;(exit 1)
#f)
target-path)
))
#f)))
|
|
|
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
|
base-path
(conc base-path "/" (string-join (cdr resolved-path) "/")))))
(if (and (not (equal? restricted-areas "" ))
(string-match (regexp restrictions) target-path))
(begin
(sauth:print-error (conc "Access denied to " (string-join resolved-path "/")))
;(exit 1)
#f)
target-path)
))
#f)))
|