|
|
@@ -79,6 +79,14 @@
|
|
|
(defparameter +400+ '(400 nil #.(trivial-utf-8:string-to-utf-8-bytes "Bad Request")))
|
|
|
(defparameter +401+ '(401 nil #.(trivial-utf-8:string-to-utf-8-bytes "Unauthorized")))
|
|
|
(defparameter +404+ '(404 nil #.(trivial-utf-8:string-to-utf-8-bytes "Not found")))
|
|
|
+(defparameter +413+
|
|
|
+ '(413 (:content-type "application/json")
|
|
|
+ #.(trivial-utf-8:string-to-utf-8-bytes
|
|
|
+ "{\"status\":\"error\",\"message\":\"File too large (max 200 MB)\"}")))
|
|
|
+(defparameter +503+
|
|
|
+ '(503 (:content-type "application/json")
|
|
|
+ #.(trivial-utf-8:string-to-utf-8-bytes
|
|
|
+ "{\"status\":\"error\",\"message\":\"Upload not configured on server\"}")))
|
|
|
(defparameter +200-empty+ '(200 (:content-type "application/json")
|
|
|
#.(trivial-utf-8:string-to-utf-8-bytes "{}")))
|
|
|
|
|
|
@@ -320,6 +328,109 @@
|
|
|
+404+))))
|
|
|
|
|
|
(defvar *mapper* (myway:make-mapper))
|
|
|
+
|
|
|
+;; ---- Upload configuration ----
|
|
|
+
|
|
|
+(defvar *upload-dir* nil
|
|
|
+ "Upload directory path. Set in config.lisp.")
|
|
|
+
|
|
|
+(defparameter *max-upload-size* (* 200 1024 1024)
|
|
|
+ "Maximum upload file size in bytes (200 MB).")
|
|
|
+
|
|
|
+(defparameter +allowed-upload-types+
|
|
|
+ '("audio/mpeg" "audio/flac" "audio/mp4" "audio/x-m4a"
|
|
|
+ "audio/wav" "audio/aiff" "audio/ogg"))
|
|
|
+
|
|
|
+(defun sanitize-filename (name)
|
|
|
+ "Keep only safe characters (alphanumeric, dot, dash, underscore, space).
|
|
|
+Truncate to 200 chars. Reject empty or all-dot results."
|
|
|
+ (let* ((clean (remove-if-not
|
|
|
+ (lambda (c)
|
|
|
+ (or (alphanumericp c) (find c ".-_ ")))
|
|
|
+ name))
|
|
|
+ (trimmed (string-left-trim ".-" clean))
|
|
|
+ (truncated (if (> (length trimmed) 200)
|
|
|
+ (subseq trimmed 0 200)
|
|
|
+ trimmed)))
|
|
|
+ (if (or (zerop (length truncated))
|
|
|
+ (every (lambda (c) (char= c #\.)) truncated))
|
|
|
+ "unnamed-upload"
|
|
|
+ truncated)))
|
|
|
+
|
|
|
+(defun parse-media-type (content-type)
|
|
|
+ "Extract base media type from Content-Type, stripping parameters.
|
|
|
+E.g. 'audio/mpeg; charset=binary' -> 'audio/mpeg'."
|
|
|
+ (when content-type
|
|
|
+ (string-trim " " (first (split-sequence:split-sequence
|
|
|
+ #\; content-type :count 1)))))
|
|
|
+
|
|
|
+(defun upload-file (params)
|
|
|
+ "PUT /api/upload — receive a raw audio file and add to library."
|
|
|
+ (declare #.*standard-optimize-settings* (ignorable params))
|
|
|
+ (with-user (info)
|
|
|
+ (unless *upload-dir*
|
|
|
+ (return-from upload-file +503+))
|
|
|
+ (let* ((headers (getf myway:*env* :headers))
|
|
|
+ (content-type (parse-media-type (gethash "content-type" headers)))
|
|
|
+ (content-length
|
|
|
+ (ignore-errors
|
|
|
+ (parse-integer
|
|
|
+ (or (gethash "content-length" headers) "")
|
|
|
+ :junk-allowed nil)))
|
|
|
+ (raw-filename (or (gethash "x-filename" headers) "upload"))
|
|
|
+ (filename (sanitize-filename raw-filename))
|
|
|
+ (body (getf myway:*env* :raw-body))
|
|
|
+ (upload-dir (uiop:ensure-directory-pathname *upload-dir*)))
|
|
|
+ ;; Validate content type
|
|
|
+ (unless (member content-type +allowed-upload-types+
|
|
|
+ :test #'string-equal)
|
|
|
+ (return-from upload-file +400+))
|
|
|
+ ;; Early reject if Content-Length exceeds limit
|
|
|
+ (when (and content-length (> content-length *max-upload-size*))
|
|
|
+ (return-from upload-file +413+))
|
|
|
+ ;; Ensure upload directory exists
|
|
|
+ (ensure-directories-exist upload-dir)
|
|
|
+ ;; Generate unique filename: timestamp-random-sanitized
|
|
|
+ (let* ((dest-name (format nil "~D-~4,'0D-~A"
|
|
|
+ (get-universal-time) (random 10000) filename))
|
|
|
+ (dest (merge-pathnames dest-name upload-dir))
|
|
|
+ (temp (merge-pathnames (concatenate 'string dest-name ".tmp")
|
|
|
+ upload-dir)))
|
|
|
+ ;; Stream to temp file with byte counting
|
|
|
+ (handler-case
|
|
|
+ (progn
|
|
|
+ (with-open-file (out temp
|
|
|
+ :direction :output
|
|
|
+ :element-type '(unsigned-byte 8)
|
|
|
+ :if-exists :supersede)
|
|
|
+ (let ((buf (make-array 65536 :element-type '(unsigned-byte 8)))
|
|
|
+ (total 0))
|
|
|
+ (loop for n = (read-sequence buf body)
|
|
|
+ while (plusp n)
|
|
|
+ do (incf total n)
|
|
|
+ (when (> total *max-upload-size*)
|
|
|
+ (error "Upload exceeds size limit"))
|
|
|
+ (write-sequence buf out :end n))))
|
|
|
+ ;; Success — atomic rename
|
|
|
+ (rename-file temp dest))
|
|
|
+ (error (e)
|
|
|
+ ;; Cleanup temp file on any error
|
|
|
+ (ignore-errors (delete-file temp))
|
|
|
+ (if (search "size limit" (princ-to-string e))
|
|
|
+ (return-from upload-file +413+)
|
|
|
+ (progn (log:error e)
|
|
|
+ (return-from upload-file +400+)))))
|
|
|
+ ;; Synchronous rescan — lock to avoid racing with rescanner thread
|
|
|
+ (bt:with-lock-held (*rescan-lock*)
|
|
|
+ (multiple-value-bind (added updated removed)
|
|
|
+ (rescan (list (namestring upload-dir)))
|
|
|
+ (declare (ignore removed))
|
|
|
+ (save-db)
|
|
|
+ (200-json
|
|
|
+ (list :|status| "imported"
|
|
|
+ :|tracks_added| added
|
|
|
+ :|albums_updated| updated))))))))
|
|
|
+
|
|
|
(myway:connect *mapper* "/api/cat/:category/size" 'get-category-size)
|
|
|
(myway:connect *mapper* "/api/cat/:category" 'get-category)
|
|
|
(myway:connect *mapper* "/api/cat" 'get-category-list)
|
|
|
@@ -329,6 +440,7 @@
|
|
|
(myway:connect *mapper* "/api/login" 'login :method :POST)
|
|
|
(myway:connect *mapper* "/api/user" 'self-info)
|
|
|
(myway:connect *mapper* "/api/user/:user" 'user-info)
|
|
|
+(myway:connect *mapper* "/api/upload" 'upload-file :method :PUT)
|
|
|
|
|
|
(defun main (&rest args &key (port 5000) (debug nil) (use-thread t) (serve-files nil) &allow-other-keys)
|
|
|
;; Load config file
|
