Initial import

2026-07-15 18:00:11 +02:00
parent 02d961e53d
commit c6954f5109
29 changed files with 3062 additions and 2 deletions
@@ -0,0 +1,95 @@
+#lang racket/base
+
+;; Typed interface for the UPnP ContentDirectory service.
+;;
+;; The Result field is returned as raw DIDL-Lite XML.  Parsing DIDL-Lite into
+;; media items belongs in a separate media-server layer.
+
+(require "../service.rkt")
+
+(provide content-directory?
+         device-content-directory
+         content-directory-browse
+         content-directory-search
+         content-result?
+         content-result-content
+         content-result-number-returned
+         content-result-total-matches
+         content-result-update-id)
+
+(struct content-result
+  (content number-returned total-matches update-id)
+  #:transparent
+  #:constructor-name make-content-result)
+
+(define (content-directory? value)
+  (and (upnp-service? value)
+       (eq? (upnp-service-kind value) 'content-directory)))
+
+(define (check-content-directory who value)
+  (unless (content-directory? value)
+    (raise-argument-error who "content-directory?" value)))
+
+(define (device-content-directory device)
+  (upnp-device-service device 'content-directory))
+
+(define (result-number result name)
+  (let ([value (hash-ref result name #f)])
+    (and value (string->number value))))
+
+(define (make-browse-result result)
+  (make-content-result
+   (hash-ref result "Result" "")
+   (result-number result "NumberReturned")
+   (result-number result "TotalMatches")
+   (result-number result "UpdateID")))
+
+(define (check-page-arguments who start count)
+  (unless (exact-nonnegative-integer? start)
+    (raise-argument-error who "exact-nonnegative-integer?" start))
+  (unless (exact-nonnegative-integer? count)
+    (raise-argument-error who "exact-nonnegative-integer?" count)))
+
+(define (content-directory-browse directory object-id
+                                  #:metadata? [metadata? #f]
+                                  #:filter [filter "*"]
+                                  #:start [start 0]
+                                  #:count [count 0]
+                                  #:sort [sort ""])
+  (check-content-directory 'content-directory-browse directory)
+  (unless (string? object-id)
+    (raise-argument-error 'content-directory-browse "string?" object-id))
+  (check-page-arguments 'content-directory-browse start count)
+  (make-browse-result
+   (upnp-service-call
+    directory
+    "Browse"
+    (list (cons "ObjectID" object-id)
+          (cons "BrowseFlag"
+                (if metadata? "BrowseMetadata" "BrowseDirectChildren"))
+          (cons "Filter" filter)
+          (cons "StartingIndex" start)
+          (cons "RequestedCount" count)
+          (cons "SortCriteria" sort)))))
+
+(define (content-directory-search directory container-id search-criteria
+                                  #:filter [filter "*"]
+                                  #:start [start 0]
+                                  #:count [count 0]
+                                  #:sort [sort ""])
+  (check-content-directory 'content-directory-search directory)
+  (unless (string? container-id)
+    (raise-argument-error 'content-directory-search "string?" container-id))
+  (unless (string? search-criteria)
+    (raise-argument-error 'content-directory-search "string?" search-criteria))
+  (check-page-arguments 'content-directory-search start count)
+  (make-browse-result
+   (upnp-service-call
+    directory
+    "Search"
+    (list (cons "ContainerID" container-id)
+          (cons "SearchCriteria" search-criteria)
+          (cons "Filter" filter)
+          (cons "StartingIndex" start)
+          (cons "RequestedCount" count)
+          (cons "SortCriteria" sort)))))