;; Copyright 2007-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(declare (unit setup))
(declare (uses session))
(require-extension srfi-69)
(require-extension regex)
;; macros in sugar don't work, have to load in all files or use compiled mode?
;;
;; (include "sugar.scm")
;; use this for getting data from page to page when scope and evals
;; get in the way
;; save data for use in the page generation here. Does NOT persist across page reads.
(define *page-data* (make-hash-table))
(define (s:lset! var val)
(hash-table-set! *page-data* var val))
(define (s:lget var . default)
(hash-table-ref/default *page-data* var (if (null? default)
#f
(car default))))
(define (s:log . msg)
(apply session:log s:session msg))
(define (s:set-err . args)
(sdat-set-curr-err! s:session args))
;; Usage: (s:get-err s:big)
(define (s:get-err wrapperfunc)
(let ((errmsg (sdat-get-curr-err s:session)))
(if errmsg ((if wrapperfunc
wrapperfunc
s:strong) errmsg) '())))
(define (s:current-page)
(sdat-get-page s:session))
(define (s:delete-session)
(session:delete-session s:session (sdat-get-session-key s:session)))
(define (s:call page . partsl)
(if (null? partsl)
(session:call s:session page #f)
(session:call s:session page (car partsl))))
(define (s:link-to page . params)
(session:link-to s:session page params))
(define (s:get-param key . type-params)
(session:get-param s:session key type-params))
;; these are page local
(define (s:get key)
(session:page-get s:session key))
(define (s:set! key val)
(session:curr-page-set! s:session key val))
(define (s:del! key)
(session:page-var-del! s:session key))
(define (s:get-n-del! key)
(let ((val (session:page-get s:session key)))
(session:del! s:session key)
val))
;; these are session wide
(define (s:session-var-get key . params)
(session:get s:session "*sessionvars*" key params))
(define (s:session-var-set! key val)
(session:set! s:session "*sessionvars*" key val))
(define (s:session-var-get-n-del! key)
(let ((val (session:page-get s:session key)))
(session:del! s:session "*sessionvars*" key)
val))
(define (s:session-var-del! key)
(session:del! s:session "*sessionvars*" key))
(define s:session-var-delete! s:session-var-del!)
;; utility to get all vars as hash table
(define (s:session-get-sessionvars)
(sdat-get-sessionvars s:session))
;; to obscure and indirect database ids use one time keys
;;
;; (s:get-key 'n 1) => "n99e1882" n=number 99e is the week number since 1970, remainder is random
;; (s:key->val "n1882") => 1
;;
;; first letter is a type: n=number, s=string, b=boolean
(define (s:get-key key-type val)
(let ((mkrandstr (lambda (innum)(number->string (random innum) 16)))
(week (number->string (quotient (current-seconds) (* 7 24 60 60)) 16)))
(let loop ((siz 1000)
(key (conc key-type week (mkrandstr 100)))
(num 0))
(if (s:session-var-get key) ;; have a collision
(loop (cond ;; in the unlikey event we have trouble getting a new var, keep increasing the size of the number
((< num 50) 100)
((< num 100) 1000)
((< num 200) 10000)
((< num 300) 100000)
((< num 400) 1000000) ;; can't imagine needing to get here. remember that this is for a single user
(else 100000000))
(conc key-type (mkrandstr siz))
(+ num 1))
(begin
(s:session-var-set! key val)
key)))))
;; given a key Xnnnn, look up the stored value and convert it appropriately, then
;; destroy the stored session var
;;
(define (s:key->val key)
(let ((val (s:session-var-get key))
(typ (string->symbol (substring key 0 1))))
(if val
(begin
(s:session-var-del! key)
;; we take this opportunity to clean up old keyed session vars
;; if more than 100 vars, remove all that are over 1-2 weeks old
;(s:cleanup-session-vars)
(case typ
((n)(string->number val))
((s) val)
(else val)))
val)))
;; clean up session vars
;;
(define (s:cleanup-session-vars)
(let* ((session-vars (hash-table-keys (s:session-get-sessionvars)))
(week-num (quotient (current-seconds) (* 7 24 60 60)))
(week (number->string week-num 16)))
(if (> (length session-vars) 100)
(for-each
(lambda (var)
(if (> (string-length var) 5) ;; can't have keyed values with keys less than 5 characters long
(let ((var-week (string->number (substring var 1 4) 16)))
(if (and var-week
(>= (- week-num var-week) 2))
(s:session-var-del! var)))))
session-vars))))
;; inputs
;;
;; param: (dtype [tag1 tag2 ...])
;; dtype:
;; 'raw : do no conversion
;; 'number : convert to number, return #f if fails
;; 'escaped : use html-escape to protect the input
;;
(define (s:get-input key . params)
(session:get-input s:session key params))
(define (s:get-input-keys)
(session:get-input-keys s:session))
;; get-input else, get-param else #f
;;
(define (s:get-inp key . params)
(or (apply s:get-input key params)
(apply s:get-param key params)))
(define (s:load-model model)
(session:load-model s:session model))
(define (s:model-path model)
(session:model-path s:session model))
;; share data between pages calls. NOTE: This is not persistent
;; between cgi calls. Use sessionvars for that.
;;
(define (s:shared-hash)
(sdat-get-shared-hash s:session))
(define (s:shared-set! key val)
(hash-table-set! (sdat-get-shared-hash s:session) key val))
;; What to return when no value for key?
;;
(define (s:shared-get key)
(hash-table-ref/default (sdat-get-shared-hash s:session) key #f))
;; http://foo.bar.com/pagename/p1/p2 => '("p1" "p2")
;; #### DEPRECATED ####
(define (s:get-page-params)
(sdat-get-path-params s:session))
(define (s:get-path-params)
(sdat-get-path-params s:session))
(define (s:db)
(sdat-get-conn s:session))
(define (s:never-called-page? page)
(session:never-called-page? s:session page))
;; find out if we are in debugmode
(define (s:debug-mode?)
(sdat-get-debugmode s:session))