jungle-server/server.lisp

;;;; server.lisp



(in-package #:server)



(defparameter *web-env* '("no" "content"))
(defparameter *env-log* (make-array '(0) :adjustable t :fill-pointer 0))

(defun request-formatter (env res now)
  (declare (ignore now))
  
  (let ((id "stranger"))
    (when-let (d (denizenp env))
      (setf id (gethash "label" (data:parsed-json d))))
    
    (format nil "~A: ~A - [~A] \"~A ~A ~A\" ~A ~A \"~:[-~;~:*~A~]\" \"~:[-~;~:*~A~]\""
	    id
	    (getf env :remote-addr)
	    (parse-clock (get-universal-time))
	    (getf env :request-method)
	    (getf env :request-uri)
	    (getf env :server-protocol)
	    (car res)
	    (lack.util:content-length res)
	    (getf env :http-referer)
	    (getf env :http-user-agent))))

(defparameter *app*
  (lack:builder
   :backtrace
   :session
   
   (:accesslog :formatter #'request-formatter)


   (:mount "/login"
	   (lambda (env)
	     (make-login-page env)))
   
   
   (:mount "/post" ;;use with postFormButton in /js/forms.js
	   (lack:builder
	    (lambda (app)
	      (lambda (env)
		(if (not (eq (getf env :request-method) :post))
		    '(404 (:content-type "text/plain") ("must be post request type"))
		    (funcall app env))))


	    (:mount "/login"
		    (lambda (env)

		      (let* ((pars (getf env :body-parameters)) 
			     (username (cdr (assoc "username" pars :test 'string=)))
			     (password (cdr (assoc "password" pars :test 'string=)))
			     (denizen (data:denizen-with-username username)))

			(print username)
			(print password)
			
			(cond
			  ((and denizen (string= (gethash "password" (data:parsed-json denizen))
						 password))
			   (with-session (env)
			     (setf (gethash 'username session) username))
			   (data:make-login (current-id env)
					    (current-ip env)
					    (current-system env)
					    (get-universal-time))

			   '(200 (:content-type "text/plain") ("/grid")))
			  (t '(200 (:content-type "text/plain") ("/login")))))))

	    
	    (lambda (env)
	      (declare (ignore env))
	      '(404 (:content-type "text/plain") ("invalid post type")))))



   
   (:static :path (lambda (p)
		    (when p
		      (cond
			((string= (pathname-type p) "js")
			 (namestring (merge-pathnames (subseq p 1) "/js/"))))))

	    
	    :root #P"~/quicklisp/local-projects/server/")
   
   
   (lambda (app)
     (lambda (env)
       (if (denizenp env)
	   (funcall app env)
	   (make-login-page env))))

   
   (:mount "/recordings"
	   (lambda (env)
	     (let ((path (subseq (getf env :request-uri) 1)))
	       (cond ((equal (pathname-type path) "wav")
		      `(200 (:content-type "audio/wave")
			    ,(merge-pathnames
			      path
			      #P"~/quicklisp/local-projects/server/")))
		     ((equal (pathname-type path) "aiff")
		      `(200 (:content-type "audio/aiff")
			    ,(merge-pathnames
			      path
			      #P"~/quicklisp/local-projects/server/")))
		     ((equal (pathname-type path) "mp3")
		      `(200 (:content-type "audio/mp3")
			    ,(merge-pathnames
			      path
			      #P"~/quicklisp/local-projects/server/")))
		     (t`(200 (:content-type "text/plain")
			     ,(merge-pathnames
			       path
			       #P"~/quicklisp/local-projects/server/")))))))

   

   (:mount "/data" *data-app*)

   (:mount "/data_server" #'data-server)

      
   (:mount "/logout"
	   (lambda (env)
	     (with-session (env)
		 (when (gethash 'username session)
		   (remhash 'username session)))
	     (make-login-page env)))

   (:mount "/chat_server" #'chat-server)

   (:mount "/music_chat_server" #'music-chat-server)

   (:mount "/wheel_world_chat_server" #'wheel-world-chat-server)

   (:mount "/jamulus_controls" #'jamulus-controls)

   (:mount "/board_game_server" #'board-game-server)

   (:mount "/grid"
	   (lambda (env)
	     (make-grid-page env)))

   (:mount "/"
	   (lambda (env)
	     (make-grid-page env)))

   
   
   (:mount ""
	   (lambda (env)
	     (make-grid-page env)))
   
   (lambda (env)
     
     ;; (let ((path-info (getf env :path-info)))
     ;;   (princ "bad path-info: ")
     ;;   (princ path-info)
       
     ;;   (cond (t '(404 (:content-type "text/plain") ("not found at all anywhere")))))
     
     
     (make-grid-page env))))


(defparameter *web-server* nil)


(defun serve ()
  (when *web-server* (stop))
  (setf *web-server* (clack:clackup *app*
				    :server :woo
				    :port 8888
				    :address "0.0.0.0")))



(defun stop () (values (clack:stop *web-server*)))