Overview
| Comment: | Needed to follow links by default in sretrieve |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
15bf67d66a300a721948f00ad08d016f |
| User & Date: | mrwellan on 2015-12-17 14:31:18 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-01-06
| ||
| 09:48 | Some fixes to address issues created by the per-section config processing code check-in: 2316fa6bc4 user: mrwellan tags: v1.60 | |
|
2015-12-17
| ||
| 14:31 | Needed to follow links by default in sretrieve check-in: 15bf67d66a user: mrwellan tags: v1.60 | |
|
2015-12-13
| ||
| 23:06 | Completed sretrieve check-in: 07c1d52486 user: matt tags: v1.60 | |
Changes
Modified rpctest/rpctest-continuous-client.scm from [9a7f357955] to [ea7c1d49cf].
| ︙ | ︙ | |||
15 16 17 18 19 20 21 | (define operation (string->symbol (car (command-line-arguments)))) (define param (cadr (command-line-arguments))) (print "Operation: " operation ", param: " param) ;; have a pool of db's to pick from (define *dbpool* '()) (define *pool-mutex* (make-mutex)) | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
(define operation (string->symbol (car (command-line-arguments))))
(define param (cadr (command-line-arguments)))
(print "Operation: " operation ", param: " param)
;; have a pool of db's to pick from
(define *dbpool* '())
(define *pool-mutex* (make-mutex))
1
(define (get-db)
(mutex-lock! *pool-mutex*)
(if (null? *dbpool*)
(begin
(mutex-unlock! *pool-mutex*)
(let ((db (open-database param)))
(set-busy-handler! db (busy-timeout 10000))
|
| ︙ | ︙ | |||
45 46 47 48 49 50 51 |
(if (eq? operation 'server)
(tcp-listen (rpc:default-server-port))
(tcp-listen 0)))
;; Start server thread
(define rpc:server
(make-thread
| | > > > > > > > | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
(if (eq? operation 'server)
(tcp-listen (rpc:default-server-port))
(tcp-listen 0)))
;; Start server thread
(define rpc:server
(make-thread
(cute (rpc:make-server rpc:listener) "rpc:server") ;; NOTE: see equivalent code below
'rpc:server))
;; This is what the code would look like without cute
;; (define rpc:server
;; (make-thread
;; (lambda ()
;; ((rpc:make-server rpc:listener) "rpc:server"))
;; 'rpc:server))
(thread-start! rpc:server)
;;; Server side
(define (server)
(rpc:publish-procedure!
|
| ︙ | ︙ |
Modified sretrieve.scm from [bdaa86239f] to [d298262aee].
| ︙ | ︙ | |||
151 152 153 154 155 156 157 |
(exit 1)))
(sretrieve:db-do
configdat
(lambda (db)
(sretrieve:register-action db "get" retriever datadir comment)))
(change-directory datadir)
| | | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 |
(exit 1)))
(sretrieve:db-do
configdat
(lambda (db)
(sretrieve:register-action db "get" retriever datadir comment)))
(change-directory datadir)
(process-execute "tar" (append (list "chfv" "-")(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 "..")
|
| ︙ | ︙ |