jungle-server/jamulus-server.lisp

(in-package :server)


(defparameter *jamulus-server* nil)

(defparameter *jamulus-recording-in-progress* nil)

(defparameter *jamulus-recording-name* nil)
(defparameter *jamulus-session* nil)


(defun jamulus-current-recording-directory ()
  (namestring
   (merge-pathnames
    "quicklisp/local-projects/server/recordings/current-recording/"
    (user-homedir-pathname))))


(defun jamulus-archive-directory ()
  (namestring
   (merge-pathnames
    "quicklisp/local-projects/server/recordings/archive/"
    (user-homedir-pathname))))

(defun jamulus-open-server ()
  (unless *jamulus-server*
    (setf *jamulus-server*
	  (sb-ext:run-program
	   "/usr/local/bin/Jamulus"
	   `("-s"
	     "-n"
	     "-R"
	     ,(jamulus-current-recording-directory)) :output :stream :wait nil))
    (sleep 1)
    (sb-ext:process-kill *jamulus-server* sb-unix:sigusr2)
    ))

(defun jamulus-start-recording (path)
  (unless *jamulus-recording-in-progress*
    (let ((session (cadr (pathname-directory path)))
	  (recording-name (pathname-name path)))
      
      (setf *jamulus-recording-in-progress* t
	    *jamulus-recording-name* (format nil "~a~a"
					     recording-name
					     (get-universal-time))
	    *jamulus-session* session))
    (mapcar #'(lambda (d)
    		(sb-ext:run-program "/bin/rm" `("-rf" ,(namestring d))))
    	    (uiop:subdirectories (jamulus-current-recording-directory)))
    (sb-ext:process-kill *jamulus-server* sb-unix:sigusr2)))

(defun jamulus-stop-recording ()
  (when *jamulus-recording-in-progress*
    (sb-ext:process-kill *jamulus-server* sb-unix:sigusr2)

    (let* ((recdir (car (uiop:subdirectories (jamulus-current-recording-directory))))
	   (files (uiop:directory-files recdir))
	   (wavs (mapcan #'(lambda (f)
			     (if (equal (pathname-type f) "wav")
				 (list (namestring f))))
			 files))
	   (args (append (if (> (length wavs) 1)
			     (list "-m"))
			 wavs
			 (list (namestring (merge-pathnames
					    (format nil "~a.mp3" *jamulus-recording-name*)
					    recdir))))))

      (unless (member-if #'(lambda (d)
			     (string= (car (last (pathname-directory d)))
				      *jamulus-session*))
			 (uiop:subdirectories (jamulus-archive-directory)))
	(sb-ext:run-program "/bin/mkdir" (list (namestring
						(merge-pathnames
						 *jamulus-session*
						 (jamulus-archive-directory))))))

      
      (sb-ext:run-program "/usr/bin/sox" args)
      (sb-ext:run-program "/bin/mv" (list (namestring recdir)
      					  (namestring
      					   (merge-pathnames
      					    (format nil "~a/~a"
						    *jamulus-session*
      						    *jamulus-recording-name*)
      					    (jamulus-archive-directory))))))
    
    (setf *jamulus-recording-in-progress* nil)))


(defun jamulus-close-server ()
  (when *jamulus-server*
    (sb-ext:process-kill *jamulus-server* sb-unix:sigkill)
    (setf *jamulus-server* nil)))


(defun jamulus-archive ()
  (let ((archive (make-hash-table :test 'equal)))
    (mapc #'(lambda (session-directory)
	      (let ((session-name (car (last (pathname-directory session-directory)))))
		(setf (gethash session-name archive)
		      (mapcar #'(lambda (recording-directory)
				  (let ((recording-name (car (last (pathname-directory
								    recording-directory)))))
				    (append (list recording-name)
					    (mapcar #'(lambda (f)
							(let ((file-name (pathname-name f))
							      (file-type (pathname-type f)))
							  (format nil
								  "/recordings/archive/~a/~a/~a.~a"
								  session-name
								  recording-name
								  file-name
								  file-type)))
						    (uiop:directory-files recording-directory)))))
			      (uiop:subdirectories session-directory)))))
	  (uiop:subdirectories (jamulus-archive-directory)))
    archive))


(defun jamulus-controls (env)
  (let ((status (make-hash-table :test 'equal))
	(path-info (getf env :path-info)))

    (cond ((> (length (pathname-directory path-info)) 1)
	   (jamulus-start-recording (format nil "~a/~a"
					    (car (last (pathname-directory path-info)))
					    (pathname-name path-info))))
	  
	  ((equal (pathname-name path-info) "open")
	   (jamulus-open-server))
	  
	  ((equal (pathname-name path-info) "close")
	   (jamulus-close-server))
	  
	  ((equal (pathname-name path-info) "stop_recording")
	   (jamulus-stop-recording)))
    
    
      
    (setf (gethash "open" status)      (if *jamulus-server* 'yason:true 'yason:false)
	  (gethash "recording" status) (if *jamulus-recording-in-progress*
					   'yason:true 'yason:false)
	  (gethash "archive" status) (jamulus-archive))
    
    `(200 (:content-type "application/json") (,(data:json status)))))