Welcome to the CHICKEN Scheme pasting service
event-dispatch pasted by mercora on Thu Aug 23 17:58:13 2012
(define (event-dispatch event-vars)
(print (format "event-vars: ~A" event-vars))
;; sofern es event filter gibt
;; event-filters =
;; (((type . "offhook")(ip . "10.10.10.123"))
;; ((type . "onhook") (ip . "10.10.10.231")))
(unless (null? event-filters)
(print "es sind filter vorhanden starte iteration")
(print (format "event filters: ~A" event-filters))
;; loop durch alle event-filter bis zum ersten kompletten match
;; es wird immer der aktuelle filter und die noch zu prüfenden filter übergeben
;; in der ersten iteration beinhaltet übrige auch den momentanen filter ????? (except NOT)
;; event-filter = ((type . "offhook")(ip . "10.10.10.123"))
;; remaining-event-filters = (((type . "onhook") (ip . "10.10.10.231")))
(let event-filter-loop ((event-filter (car event-filters))
(remaining-event-filters (cdr event-filters)))
(print (format "event-filter: ~A" event-filter))
(print (format "remaining-event-filters: ~A" remaining-event-filters))
;; jeder filter besteht aus einer alist mit den zu übereinstimmenden werten
;; jeder wert muss passen daher wird durch alle vorhandenen werten aus dem filter iteriert und
;; überprüft ob alle werte passen sollte das einmal nicht der fall sein wird die iteration unterbrochen
;; und der nächste filter wird versucht anzuwenden...
;; filter-var = (type . "offhook")
;; remaining filter-vars = (ip . "10.10.10.123")
(print "beginne iteration mit vergleich über alle werte von event-filter")
(let filter-var-loop ((filter-var (car event-filters))
(remaining-filter-vars (cdr event-filters)))
(print (format "filter-var: ~A" filter-var))
(print (format "remaining-filter-vars: ~A" remaining-filter-vars))
(print (format "~A vs ~A on ~A" (cdr (car filter-var)) (alist-ref (car (car filter-var)) event-vars) (car (car filter-var))))
;; prüfen ob der wert im filter dem event gleicht
(if (equal? (cdr (car filter-var)) ;; "offhook"
(alist-ref (car (car filter-var)) event-vars)) ;; "type"
;; die beiden werte stimmen überein jetzt muss geprüft werden ob es noch
;; weitere werte zu vergleichen gillt
(begin
(print "filter wert stimmt überein prüfe weitere werte des filters")
(if (null? remaining-filter-vars)
;; es gibt keine weiteren werte der filter hat komplett übereingestimmt
;; es muss keine weitere iteration durchgeführt werden und der filter
;; aus der liste der filter entfernt werden dafür wird wieder undzwar
;; ganz genauso durch die filter iteriert bis jener gefunden wird der
;; komplett übereinstimmt und dieser dann aus der liste geworfen und
;; die neue liste event-filters zugewiesen und die event-vars am
;; mutex-specific field angehangen
;; current-filter-vars = ((type . "offhook")(ip . "10.10.10.123"))
(begin
(print "keine weiteren werte im filter vorhanden lösche filter aus event-filters liste")
(set! event-filters
(remove (lambda (current-filter-vars)
(print (format "prüfe filter\n~A\n-vs-\n~A" event-vars current-filter-vars))
(print "beginne iteration über die werte")
;; es wird der zu löschende filter gesucht in dem alle event-filters
;; in der liste mit event-filter verglichen und das genau übereinstimmende
;; element (werte und länge) gibt #t zurück
(let remove-filter-loop ((current-filter-var (car current-filter-vars))
(remaining-current-filter-vars (cdr current-filter-vars)))
(print (format "current-filter-var: ~A" current-filter-var))
(print (format "remaining-current-filter-vars: ~A" remaining-current-filter-vars))
(print (format "prüfe werte ~A vs ~A on ~A"
(cdr filter-var)
(alist-ref (car filter-var) current-filter-var)
(car filter-var)))
(if (equal? (cdr filter-var)
(alist-ref (car filter-var) current-filter-var))
;; wert stimmt überein
(begin
(print "wert stimmt überein")
(if (null? remaining-current-filter-vars)
;; filter hat keine weiteren werte und wurde damit gefunden
(begin
(print "keine weiteren werte vorhanden lösche diesen filter")
#t)
;; filter hat noch weitere werte also wird mit der nächsten iteration fortgefahren
(begin
(print "filter hat noch weitere werte... fahre fort")
(remove-filter-loop (car remaining-current-filter-vars)
(cdr remaining-current-filter-vars)))
))
;; wert unterscheidet sich
(begin
(print "werte unterscheiden sich behalte filter in der lsite")
#f))
))
event-filters))
(print (format "setze mutex-specific field von ~A auf ~A"
(cons (mutex-specific event-mutex)
event-vars)
(mutex-specific event-mutex)))
(mutex-specific-set! event-mutex
(cons (mutex-specific event-mutex)
event-vars))
(print (format "mutex-specific field hält nun ~A" (mutex-specific event-mutex))))
;; es gibt weitere werte im filter die es zu prüfen gillt also beginnt die
;; nächste iteration mit dem nächsten wert und die liste der zu verbleibenden werte
;; wird reduziert und an den loop übergeben
(unless (null? remaining-filter-vars)
(print "looping filter vars")
(filter-var-loop (car remaining-filter-vars)
(cdr remaining-filter-vars)))))
;; die beiden werte stimmen nicht überein der filter findet also keine anwendung
;; die iteration beginnt von vorne mit dem nächsten filter und die liste der
;; zu verbleibenden filter wird reduziert und auch an den loop übergeben
(unless (null? remaining-event-filters)
(print "looping event filters")
(event-filter-loop (car remaining-event-filters)
(cdr remaining-event-filters)))))))
(if (null? event-filters)
(mutex-unlock! event-mutex)
(print "nisch leer"))
(send-response code: 200
body: "yiah"))kikowaena added by mercora on Thu Aug 23 19:15:19 2012
#!/usr/local/bin/csi -s
(use spiffy intarweb uri-common srfi-18 srfi-1)
(access-log (open-output-file "access.log"))
(default-mime-type 'text/plain')
(vhost-map `((".*" .
,(lambda (continue)
(let ((uri (request-uri (current-request))))
(if (= (length (uri-path uri)) 2)
(if (equal? (list-ref (uri-path uri) 1) "trigger.scm")
(event-dispatch (uri-query uri))
(send-response status: 'forbidden
body: "FORBIDDEN"))
(send-response status: 'forbidden
body: "FORBIDDEN")))))))
(define event-server-thread
(thread-start!
(make-thread (lambda ()
(start-server port: 8080)) 'event-server-thread)))
(define event-mutex (make-mutex 'event))
(define (event-dispatch event-vars)
(print (format "event-vars: ~A" event-vars))
;; sofern es event filter gibt
;; event-filters =
;; (((type . "offhook")(ip . "10.10.10.123"))
;; ((type . "onhook") (ip . "10.10.10.231")))
(unless (null? event-filters)
(print "es sind filter vorhanden starte iteration")
(print (format "event filters: ~A" event-filters))
;; loop durch alle event-filter bis zum ersten kompletten match
;; es wird immer der aktuelle filter und die noch zu prüfenden filter übergeben
;; in der ersten iteration beinhaltet übrige auch den momentanen filter ????? (except NOT)
;; event-filter = ((type . "offhook")(ip . "10.10.10.123"))
;; remaining-event-filters = (((type . "onhook") (ip . "10.10.10.231")))
(let event-filter-loop ((event-filter (car event-filters))
(remaining-event-filters (cdr event-filters)))
(print (format "event-filter: ~A" event-filter))
(print (format "remaining-event-filters: ~A" remaining-event-filters))
;; jeder filter besteht aus einer alist mit den zu übereinstimmenden werten
;; jeder wert muss passen daher wird durch alle vorhandenen werten aus dem filter iteriert und
;; überprüft ob alle werte passen sollte das einmal nicht der fall sein wird die iteration unterbrochen
;; und der nächste filter wird versucht anzuwenden...
;; filter-var = (type . "offhook")
;; remaining filter-vars = (ip . "10.10.10.123")
(print "beginne iteration mit vergleich über alle werte von event-filter")
(let filter-var-loop ((filter-var (car event-filters))
(remaining-filter-vars (cdr event-filters)))
(print (format "filter-var: ~A" filter-var))
(print (format "remaining-filter-vars: ~A" remaining-filter-vars))
(print (format "~A vs ~A on ~A" (cdr (car filter-var)) (alist-ref (car (car filter-var)) event-vars) (car (car filter-var))))
;; prüfen ob der wert im filter dem event gleicht
(if (equal? (cdr (car filter-var)) ;; "offhook"
(alist-ref (car (car filter-var)) event-vars)) ;; "type"
;; die beiden werte stimmen überein jetzt muss geprüft werden ob es noch
;; weitere werte zu vergleichen gillt
(begin
(print "filter wert stimmt überein prüfe weitere werte des filters")
(if (null? remaining-filter-vars)
;; es gibt keine weiteren werte der filter hat komplett übereingestimmt
;; es muss keine weitere iteration durchgeführt werden und der filter
;; aus der liste der filter entfernt werden dafür wird wieder undzwar
;; ganz genauso durch die filter iteriert bis jener gefunden wird der
;; komplett übereinstimmt und dieser dann aus der liste geworfen und
;; die neue liste event-filters zugewiesen und die event-vars am
;; mutex-specific field angehangen
;; current-filter-vars = ((type . "offhook")(ip . "10.10.10.123"))
(begin
(print "keine weiteren werte im filter vorhanden lösche filter aus event-filters liste")
(set! event-filters
(remove (lambda (current-filter-vars)
(print (format "prüfe filter\n~A\n-vs-\n~A" event-vars current-filter-vars))
(print "beginne iteration über die werte")
;; es wird der zu löschende filter gesucht in dem alle event-filters
;; in der liste mit event-filter verglichen und das genau übereinstimmende
;; element (werte und länge) gibt #t zurück
(let remove-filter-loop ((current-filter-var (car current-filter-vars))
(remaining-current-filter-vars (cdr current-filter-vars)))
(print (format "current-filter-var: ~A" current-filter-var))
(print (format "remaining-current-filter-vars: ~A" remaining-current-filter-vars))
(print (format "prüfe werte ~A vs ~A on ~A"
(cdr filter-var)
(alist-ref (car filter-var) current-filter-var)
(car filter-var)))
(if (equal? (cdr filter-var)
(alist-ref (car filter-var) current-filter-var))
;; wert stimmt überein
(begin
(print "wert stimmt überein")
(if (null? remaining-current-filter-vars)
;; filter hat keine weiteren werte und wurde damit gefunden
(begin
(print "keine weiteren werte vorhanden lösche diesen filter")
#t)
;; filter hat noch weitere werte also wird mit der nächsten iteration fortgefahren
(begin
(print "filter hat noch weitere werte... fahre fort")
(remove-filter-loop (car remaining-current-filter-vars)
(cdr remaining-current-filter-vars)))
))
;; wert unterscheidet sich
(begin
(print "werte unterscheiden sich behalte filter in der lsite")
#f))
))
event-filters))
(print (format "setze mutex-specific field von ~A auf ~A"
(cons (mutex-specific event-mutex)
event-vars)
(mutex-specific event-mutex)))
(mutex-specific-set! event-mutex
(cons (mutex-specific event-mutex)
event-vars))
(print (format "mutex-specific field hält nun ~A" (mutex-specific event-mutex))))
;; es gibt weitere werte im filter die es zu prüfen gillt also beginnt die
;; nächste iteration mit dem nächsten wert und die liste der zu verbleibenden werte
;; wird reduziert und an den loop übergeben
(unless (null? remaining-filter-vars)
(print "looping filter vars")
(filter-var-loop (car remaining-filter-vars)
(cdr remaining-filter-vars)))))
;; die beiden werte stimmen nicht überein der filter findet also keine anwendung
;; die iteration beginnt von vorne mit dem nächsten filter und die liste der
;; zu verbleibenden filter wird reduziert und auch an den loop übergeben
(unless (null? remaining-event-filters)
(print "looping event filters")
(event-filter-loop (car remaining-event-filters)
(cdr remaining-event-filters)))))))
(if (null? event-filters)
(mutex-unlock! event-mutex)
(print "nisch leer"))
(send-response code: 200
body: "yiah"))
(define event-filters '())
(define (add-event-filter filter-vars)
(set! event-filters (cons filter-vars event-filters))
(print (format "added event filter: ~A" filter-vars)))
(use http-client)
(define (dial from to)
;; server is running ignores everything
(add-event-filter '((type . "incomming-call") (ip . "10.10.10.194")))
(add-event-filter '((type . "outgoing-call") (ip . "10.10.10.186")))
;; lock the server
;; make the request
;; lock the event
;; unlock the server
;;
(mutex-lock! event-mutex) ;; lock event-mutex
;; (mutex-lock! event-mutex) ;; get the request (matched filters will unlock)
(with-input-from-request (string-append "http://10.10.10.194/command.htm?number=" (number->string to)) #f read-all) ;; generate the request
(repl)
(print (mutex-specific event-mutex)))
(dial #f 123)