Overview
| Comment: | Set sretrieve to work with data visible to user but control data not accessible |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
031a5ee554c014c601407428fc166478 |
| User & Date: | mrwellan on 2016-02-01 22:32:23 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-02-01
| ||
| 23:22 | Fixed silly issue caused by accidentally checking in changes made while discussing code for illustration purposes check-in: 4cf5c411c5 user: matt tags: v1.60 | |
| 22:32 | Set sretrieve to work with data visible to user but control data not accessible check-in: 031a5ee554 user: mrwellan tags: v1.60 | |
| 16:54 | Added static and PROXY to Makefile for sretrieve check-in: 6be112f8aa user: mrwellan tags: v1.60 | |
Changes
Modified sretrieve.scm from [8380ec9aed] to [911a84e53e].
| ︙ | ︙ | |||
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 |
;; RECORDS
;;======================================================================
;;======================================================================
;; DB
;;======================================================================
(define (sretrieve:initialize-db db)
(for-each
(lambda (qry)
(exec (sql db qry)))
(list
"CREATE TABLE IF NOT EXISTS actions
(id INTEGER PRIMARY KEY,
action TEXT NOT NULL,
retriever TEXT NOT NULL,
| > | | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
;; RECORDS
;;======================================================================
;;======================================================================
;; DB
;;======================================================================
;; replace (strftime('%s','now')), with datetime('now'))
(define (sretrieve:initialize-db db)
(for-each
(lambda (qry)
(exec (sql db qry)))
(list
"CREATE TABLE IF NOT EXISTS actions
(id INTEGER PRIMARY KEY,
action TEXT NOT NULL,
retriever TEXT NOT NULL,
datetime TIMESTAMP DEFAULT (datetime('now','localtime')),
srcpath TEXT NOT NULL,
comment TEXT DEFAULT '' NOT NULL,
state TEXT DEFAULT 'new');"
"CREATE TABLE IF NOT EXISTS bundles
(id INTEGER PRIMARY KEY,
bundle TEXT NOT NULL,
release TEXT NOT NULL,
|
| ︙ | ︙ | |||
151 152 153 154 155 156 157 |
(debug:print 0 "ERROR: Bad version (" version "), no data found at " datadir "." )
(exit 1)))
(sretrieve:db-do
configdat
(lambda (db)
(sretrieve:register-action db "get" retriever datadir comment)))
| > > | | | | > > > > > > | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 |
(debug:print 0 "ERROR: Bad version (" version "), no data found at " datadir "." )
(exit 1)))
(sretrieve:db-do
configdat
(lambda (db)
(sretrieve:register-action db "get" retriever datadir comment)))
(sretrieve:do-as-calling-user
(lambda ()
(change-directory datadir)
(let ((files (filter (lambda (x)
(not (member x '("." ".."))))
(glob "*" ".*"))))
(print "files: " files)
(process-execute "/bin/tar" (append (list "chfv" "-") files)))))))
;;(filter (lambda (x)
;; (not (member x '("." ".."))))
;; (glob "*" ".*"))))))))
(define (sretrieve:validate target-dir targ-mk)
(let* ((normal-path (normalize-pathname targ-mk))
(targ-path (conc target-dir "/" normal-path)))
(if (string-contains normal-path "..")
(begin
(debug:print 0 "ERROR: Path " targ-mk " resolved outside target area " target-dir )
|
| ︙ | ︙ | |||
429 430 431 432 433 434 435 | ((list-vars) ;; print out the ini file (map print (sretrieve:get-areas configdat))) ((ls) (let* ((base-dir (configf:lookup configdat "settings" "base-dir"))) (if base-dir (begin (print "Files in " base-dir) | > > | | 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 |
((list-vars) ;; print out the ini file
(map print (sretrieve:get-areas configdat)))
((ls)
(let* ((base-dir (configf:lookup configdat "settings" "base-dir")))
(if base-dir
(begin
(print "Files in " base-dir)
(sretrieve:do-as-calling-user
(lambda ()
(process-execute "/bin/ls" (list base-dir)))))
(print "ERROR: No base dir specified!"))))
((log)
(sretrieve:db-do configdat (lambda (db)
(print "Listing actions")
(query (for-each-row
(lambda (row)
(apply print (intersperse row " | "))))
|
| ︙ | ︙ |