123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148 |
- (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)))))
|