Megatest

Diff
Login

Differences From Artifact [28ffd8e69e]:

To Artifact [29d676d589]:


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)))