Merge branch 'feature/upload-endpoint' of chad-partners/chad-music into master

back/config.lisp.example

@@ -1,3 +1,7 @@
 (in-package :chad-music.server)
 
-(setf *path-url-mappings* '(("/media/music/" . "/music/")))
+(setf *path-url-mappings* '(("/media/music/" . "/music/")
+                            ("/data/upload/mixboard/" . "/upload/")))
+
+;; Upload directory — set to enable PUT /api/upload
+(setf *upload-dir* #p"/data/upload/mixboard/")

back/server.lisp

@@ -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