commit b637f2779d1bf89abf77307df38f431e8b9f33c2
parent a2dd25809c045da65c80ff9678d642e882126a6b
Author: Tomas Hlavaty <tom@logand.com>
Date: Sat, 10 Aug 2013 22:25:59 +0200
read|write-value introduced
Diffstat:
| M | ipp.lisp | | | 185 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------- |
1 file changed, 127 insertions(+), 58 deletions(-)
diff --git a/ipp.lisp b/ipp.lisp
@@ -66,53 +66,87 @@
;;(tag #x45)
;;(tag :uri)
-(defun attribute-tag (attribute)
- (cdr (assoc attribute '((:attributes-charset . :charset)
- (:attributes-natural-language . :naturalLanguage)
- (:printer-uri . :uri)
- (:requesting-user-name . :nameWithoutLanguage)
- (:job-name . :nameWithoutLanguage)
- (:ipp-attribute-fidelity . :boolean)
- (:document-name . nil)
- (:document-format . nil)
- (:document-natural-language . :naturalLanguage)
- (:compression . nil)
- (:job-k-octets . nil)
- (:job-impressions . nil)
- (:job-media-sheets . nil)))))
+(let ((attributes '((:attributes-charset . :charset)
+ (:attributes-natural-language . :naturalLanguage)
+ (:printer-uri . :uri)
+ (:requesting-user-name . :nameWithoutLanguage)
+ (:job-name . :nameWithoutLanguage)
+ (:ipp-attribute-fidelity . :boolean)
+ (:document-name . nil)
+ (:document-format . nil)
+ (:document-natural-language . :naturalLanguage)
+ (:compression . nil)
+ (:job-k-octets . nil)
+ (:job-impressions . nil)
+ (:job-media-sheets . nil)
+ (:copies . :integer)
+ (:sides . :keyword)
+ (:job-uri . nil)
+ (:job-id . nil)
+ (:job-state . nil)
+ (:job-state-reasons . nil))))
+
+ (defun attribute-tag (attribute)
+ (cdr (assoc attribute attributes)))
+
+ (let ((x (loop
+ for (k) in attributes
+ collect (cons (string-downcase (symbol-name k)) k))))
+ (defun attribute-keyword (string)
+ (or (cdr (assoc string x :test #'equal))
+ (error "unknown attribute ~s" string)))))
;;(attribute-tag :printer-uri)
+;;(attribute-keyword "printer-uri")
(defun attribute-name (attribute)
(format nil "~(~a~)" attribute))
;;(attribute-name :attributes-charset)
+(defun read-text (reader)
+ (octets-to-string (rw:next-octets reader (rw:next-u16 reader))))
+
+(defun read-value (reader tag)
+ (ecase tag
+ ;; :no-value
+ ((:integer :enum)
+ (assert (= 4 (rw:next-u16 reader)))
+ (rw:next-u32 reader))
+ (:boolean
+ (assert (= 1 (rw:next-u16 reader)))
+ (not (zerop (rw:next-u32 reader))))
+ ;; :octetString
+ ;; :dateTime
+ ;; :resolution
+ ;; :rangeOfInteger
+ ((:textWithLanguage
+ :nameWithLanguage
+ :textWithoutLanguage
+ :nameWithoutLanguage
+ :keyword
+ :uri
+ :uriScheme
+ :charset
+ :naturalLanguage
+ :mimeMediaType)
+ (read-text reader))))
+
(defun read-attribute (reader)
- (let ((tag (rw:next-u8 reader)))
- (if (member tag (mapcar 'tag ;; TODO optimize
- '(:operation-attributes-tag
- :job-attributes-tag
- :end-of-attributes-tag
- :printer-attributes-tag
- :unsupported-attributes-tag)))
+ (let ((tag (tag (rw:next-u8 reader))))
+ (if (member tag '(:operation-attributes-tag
+ :job-attributes-tag
+ :end-of-attributes-tag
+ :printer-attributes-tag
+ :unsupported-attributes-tag))
tag
- (flet ((text ()
- (octets-to-string
- (rw:next-octets reader (rw:next-u16 reader)))))
- `(,tag ;;(tag (attribute-tag k))
- ,(text)
- , (case tag ;; TODO handle more cases
- ((33 35)
- (assert (= 4 (rw:next-u16 reader)))
- (rw:next-u32 reader))
- (t (text))))))))
+ (list (attribute-keyword (read-text reader))
+ (read-value reader tag)))))
(defun read-groups (reader)
- (let ((sentinel (tag :end-of-attributes-tag)) ;; TODO optimize
- (x (rw:next-u8 reader)))
+ (let ((x (tag (rw:next-u8 reader))))
(loop
- until (= sentinel x)
+ until (eq :end-of-attributes-tag x)
collect `(,x
,@(loop
while (consp (setq x (read-attribute reader)))
@@ -122,24 +156,51 @@
(with-open-file (s "response.dat" :element-type '(unsigned-byte 8))
(read-ipp (rw:byte-reader s) 314))
+(defun write-text (writer x)
+ (let ((y (string-to-octets x)))
+ (rw:write-u16 writer (length y))
+ (rw:write-octets writer y)))
+
+(defun write-value (writer tag x)
+ (ecase tag
+ ;; :no-value
+ ((:integer :enum)
+ (rw:write-u16 writer 4)
+ (rw:write-u32 writer x))
+ (:boolean
+ (rw:write-u16 writer 1)
+ (rw:write-u8 writer (if x 1 0)))
+ ;; :octetString
+ ;; :dateTime
+ ;; :resolution
+ ;; :rangeOfInteger
+ ((:textWithLanguage
+ :nameWithLanguage
+ :textWithoutLanguage
+ :nameWithoutLanguage
+ :keyword
+ :uri
+ :uriScheme
+ :charset
+ :naturalLanguage
+ :mimeMediaType)
+ (write-text writer x))))
+
(defun write-group (writer group)
(destructuring-bind (group-id &rest plist) group
(when (loop
- for (k v) on plist by #'cddr
+ for (v) on (cdr plist) by #'cddr
when v
do (return t))
(rw:write-u8 writer group-id)
(loop
for (k v) on plist by #'cddr
when v
- do (let ((%k (string-to-octets (attribute-name k)))
- (%v (string-to-octets v)))
+ do (let ((tag (attribute-tag k)))
;; TODO additional value (when v is list)
- (rw:write-u8 writer (tag (attribute-tag k)))
- (rw:write-u16 writer (length %k))
- (rw:write-octets writer %k)
- (rw:write-u16 writer (length %v))
- (rw:write-octets writer %v))))))
+ (rw:write-u8 writer (tag tag))
+ (write-text writer (attribute-name k))
+ (write-value writer tag v))))))
(defun operation-code (operation)
(cdr (assoc operation '((:print-job 1 0 #x0002)
@@ -238,14 +299,16 @@
(attributes-natural-language "en")
(requesting-user-name (user-name))
job-name
- ipp-attribute-fidelity
- document-name
- document-format
- document-natural-language
- compression
- job-k-octets
- job-impressions
- job-media-sheets)
+ (ipp-attribute-fidelity t)
+ ;; document-name
+ ;; document-format
+ ;; document-natural-language
+ ;; compression
+ ;; job-k-octets
+ ;; job-impressions
+ ;; job-media-sheets
+ copies
+ sides)
(ipp ipp-client
printer-uri
request-file
@@ -261,13 +324,15 @@
:requesting-user-name ,requesting-user-name
:job-name ,job-name
:ipp-attribute-fidelity ,ipp-attribute-fidelity
- :document-name ,document-name
- :document-format ,document-format
- :document-natural-language ,document-natural-language
- :compression ,compression
- :job-k-octets ,job-k-octets
- :job-impressions ,job-impressions
- :job-media-sheets ,job-media-sheets))))
+ ;; :document-name ,document-name
+ ;; :document-format ,document-format
+ ;; :document-natural-language ,document-natural-language
+ ;; :compression ,compression
+ ;; :job-k-octets ,job-k-octets
+ ;; :job-impressions ,job-impressions
+ ;; :job-media-sheets ,job-media-sheets
+ :copies ,copies
+ :sides ,sides))))
(defun printer-search-reader (reader)
(let* ((k '#.(coerce "\"/printers/" 'list)) ;; TODO #\' as attribute quote
@@ -379,7 +444,11 @@
"request2.dat"
"response2.dat"
"test.txt"
- 314)
+ 314
+ :ipp-attribute-fidelity nil
+ :copies 2
+ :sides "two-sided-long-edge"
+ )
#+nil
(ipp:list-printers 'ipp-client
