Commit 4631f682 authored by Dave Griffiths's avatar Dave Griffiths

filtering URI chars

parent a032bb6f
......@@ -239,30 +239,36 @@
"&version=" (number->string (list-ref (car e) 3))
(build-url-from-ktvlist (cadr e))))
(define (is-image? filename)
(equal? (substring filename 3) "jpg"))
(and
(> (string-length filename) 3)
(equal? (substring filename (- (string-length filename) 3)) "jpg")))
(define (proc+upload-file filename r)
(if (is-image? filename)
(append
(list
;; make sure we're not sending mahusiv images to sync
(process-image-in-place
(string-append "/sdcard/symbai/files/" filename))
(http-upload
(string-append "upload-" filename)
"http://192.168.2.1:8889/symbai?fn=upload"
(string-append "/sdcard/symbai/files/" filename)))
r)
(cons (http-upload
(string-append "upload-" filename)
"http://192.168.2.1:8889/symbai?fn=upload"
(string-append "/sdcard/symbai/files/" filename))
r)))
;; todo fix all hardcoded paths here
(define (send-files ktvlist)
(foldl
(lambda (ktv r)
(if (equal? (ktv-type ktv) "file")
(if (is-image? (ktv-value ktv))
(append
(list
;; make sure we're not sending mahusiv images to sync
(process-image-in-place
(string-append "/sdcard/symbai/files/" (ktv-value ktv)))
(http-upload
(string-append "upload-" (ktv-value ktv))
"http://192.168.2.1:8889/symbai?fn=upload"
(string-append "/sdcard/symbai/files/" (ktv-value ktv)))) r)
(cons (http-upload
(string-append "upload-" (ktv-value ktv))
"http://192.168.2.1:8889/symbai?fn=upload"
(string-append "/sdcard/symbai/files/" (ktv-value ktv)))
r))
(proc+upload-file (ktv-value ktv) r)
r))
'() ktvlist))
......@@ -276,14 +282,9 @@
(foldl
(lambda (file r)
;; send files not present
(if (or
(eqv? (string-ref file 0) #\.)
(in-list? file server-list))
r (cons
(http-upload
(string-append "upload-" file)
"http://192.168.2.1:8889/symbai?fn=upload"
(string-append "/sdcard/symbai/files/" file)) r)))
(if (or (eqv? (string-ref file 0) #\.)
(in-list? file server-list))
r (proc+upload-file file r)))
'()
local-list)
;; search for all server files in local list
......@@ -370,8 +371,6 @@
r))
'() ktvlist))
(msg "suck ent")
(define (suck-entity-from-server db table unique-id)
;; ask for the current version
(http-request
......@@ -416,7 +415,7 @@
;; if we don't have this entity or the version on the server is newer
(if (and (or (not exists) old)
;; limit this to 5 a time
(< (length r) 5))
(< (length r) 1))
(cons (suck-entity-from-server db table unique-id) r)
r)))
'()
......@@ -471,8 +470,6 @@
(play-sound "active")
new-entity-requests))))))))
(msg "build-dirty defined...")
(define (build-dirty db)
(let ((sync (get-dirty-stats db "sync")))
(string-append
......
......@@ -1305,10 +1305,9 @@
;; need to reset the individual from the db now (as update reset it)
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" unique-id)))
(append
;; (if (eqv? resultcode -1)
;; (list (process-image-in-place (string-append "/sdcard/symbai/files/" (get-current 'photo-name "error no photo name!!"))))
;; '())
'()
(if (eqv? resultcode -1)
(list (process-image-in-place (string-append "/sdcard/symbai/files/" (get-current 'photo-name "error no photo name!!"))))
'())
(list
(mupdate 'image-view 'photo "photo"))))
(else
......
......@@ -69,7 +69,7 @@
(let ((de (db-select
db (string-append
"select entity_id, entity_type, unique_id, dirty, version from "
table "_entity where dirty=1 limit 5;"))))
table "_entity where dirty=1 limit 1;"))))
(if (null? de)
'()
(map
......
......@@ -68,15 +68,50 @@
(number->string (ktv-value ktv))
(ktv-value ktv)))))
;; filter uri chars
(define (filter-uri-chars s)
(list->string
(filter
(lambda (v)
(not (or
(eqv? v #\newline)
(eqv? v #\!)
(eqv? v #\*)
(eqv? v #\')
(eqv? v #\()
(eqv? v #\))
(eqv? v #\;)
(eqv? v #\:)
(eqv? v #\@)
(eqv? v #\&)
(eqv? v #\=)
(eqv? v #\+)
(eqv? v #\$)
(eqv? v #\,)
(eqv? v #\/)
(eqv? v #\?)
(eqv? v #\#)
(eqv? v #\[)
(eqv? v #\]))))
(string->list s))))
(msg "TESTING FILTER URI CHARS")
(msg (filter-uri-chars "1234"))
(msg (filter-uri-chars "12&34"))
(msg (filter-uri-chars "1\
234"))
(msg (filter-uri-chars "12[[]]34"))
;; stringify based on type (for url)
(define (stringify-value-url ktv)
(cond
((null? (ktv-value ktv)) "NULL")
((equal? (ktv-type ktv) "varchar") (ktv-value ktv))
(else
(if (not (string? (ktv-value ktv)))
(number->string (ktv-value ktv))
(ktv-value ktv)))))
(filter-uri-chars
(cond
((null? (ktv-value ktv)) "NULL")
((equal? (ktv-type ktv) "varchar") (ktv-value ktv))
(else
(if (not (string? (ktv-value ktv)))
(number->string (ktv-value ktv))
(ktv-value ktv))))))
;; tests...
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment