105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
;; (lambda (db)
;; (set-busy-handler! db (busy-timeout 10000)) ; 10 second timeout
;; ...))
;; Create the sqlite db
(define (spublish:db-do configdat proc)
(let ((path (configf:lookup configdat "database" "location")))
(if (and path
(directory? path)
(file-read-access? path))
(let* ((dbpath (conc path "/spublish.db"))
(writeable (file-write-access? dbpath))
(dbexists (file-exists? dbpath)))
(handle-exceptions
|
>
>
>
>
|
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
;; (lambda (db)
;; (set-busy-handler! db (busy-timeout 10000)) ; 10 second timeout
;; ...))
;; Create the sqlite db
(define (spublish:db-do configdat proc)
(let ((path (configf:lookup configdat "database" "location")))
(if (not path)
(begin
(print "[database]\nlocation /some/path\n\n Is missing from the config file!")
(exit 1)))
(if (and path
(directory? path)
(file-read-access? path))
(let* ((dbpath (conc path "/spublish.db"))
(writeable (file-write-access? dbpath))
(dbexists (file-exists? dbpath)))
(handle-exceptions
|
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
|
;; (ini:read-ini fname)
(read-config fname #f #t)
(make-hash-table))))
(define (spublish:process-action configdat action . args)
(let* ((target-dir (configf:lookup configdat "settings" "target-dir"))
(user (current-user-name))
(allowed-users (configf:lookup configdat "settings" "allowed-users")))
(if (not (member user allowed-users))
(begin
(print "User \"" (current-user-name) "\" does not have access. Exiting")
(exit 1)))
(case (string->symbol action)
((cp)
(if (< (length args) 1)
|
>
|
>
>
>
>
>
>
>
>
>
|
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
|
;; (ini:read-ini fname)
(read-config fname #f #t)
(make-hash-table))))
(define (spublish:process-action configdat action . args)
(let* ((target-dir (configf:lookup configdat "settings" "target-dir"))
(user (current-user-name))
(allowed-users (string-split
(or (configf:lookup configdat "settings" "allowed-users")
""))))
(if (not target-dir)
(begin
(print "[settings]\ntarget-dir /some/path\n\n Is MISSING from the config file!")
(exit)))
(if (null? allowed-users)
(begin
(print "[setings]\nallowed-users user1 user2 ...\n\n Is MISSING from the config file!")
(exit)))
(if (not (member user allowed-users))
(begin
(print "User \"" (current-user-name) "\" does not have access. Exiting")
(exit 1)))
(case (string->symbol action)
((cp)
(if (< (length args) 1)
|