cl-ipp

Internet Printing Protocol (IPP) for Common Lisp
git clone https://logand.com/git/cl-ipp.git/
Log | Files | Refs

commit 122080c3cbb2b50ad04a8d1b75447ca7ffe9fe84
parent 6d7c4756690a788f2d1cbcf4c5eb1c9aff91c91e
Author: Tomas Hlavaty <tom@logand.com>
Date:   Mon, 12 Aug 2013 00:36:40 +0200

curry the monstrosity

Diffstat:
Mipp.lisp | 726+++++++++++++++++++++++++++++--------------------------------------------------
1 file changed, 261 insertions(+), 465 deletions(-)

diff --git a/ipp.lisp b/ipp.lisp @@ -22,13 +22,22 @@ (defpackage :ipp (:use :cl) - (:export :create-job + (:export :cancel-job + :create-job + :disable-printer + :enable-printer + :get-job-attributes :get-jobs :get-printer-attributes + :hold-job :list-printers + :make-job + :make-printer :pause-printer :print-job :purge-jobs + :release-job + :restart-job :resume-printer :validate-job)) @@ -92,12 +101,13 @@ (:copies . :integer) (:sides . :keyword) (:job-uri . :uri) - (:job-id . nil) + (:job-id . :integer) (:job-state . nil) (:job-state-reasons . nil) (:limit . :integer) (:requested-attributes . :keyword) - (:status-message . :nameWithoutLanguage) really? + (:status-message . :textWithoutLanguage) + (:message . :textWithoutLanguage) ;; TODO really? (:marker-change-time . nil) (:printer-current-time . nil) (:printer-dns-sd-name . nil) @@ -426,53 +436,78 @@ (defun user-name () (car (last (pathname-directory (user-homedir-pathname))))) -(defun print-job (ipp-client - printer-uri - request-file - response-file - data-file - request-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name)) - job-name - (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 - response-file - data-file - request-id - :print-job - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri) - (,(tag :job-attributes-tag) - :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 - :copies ,copies - :sides ,sides)))) - -(defun validate-job (ipp-client +(defun get-printer-attributes (printer &key requested-attributes + document-format limit) + (funcall printer :get-printer-attributes + :requested-attributes requested-attributes + :document-format document-format + :limit limit)) + +(defun pause-printer (printer) + (funcall printer :pause-printer)) + +(defun resume-printer (printer) + (funcall printer :resume-printer)) + +(defun enable-printer (printer) + (funcall printer :enable-printer)) + +(defun disable-printer (printer) + (funcall printer :disable-printer)) + +(defun create-job (printer) + (funcall printer :create-job)) + +(defun purge-jobs (printer) + (funcall printer :purge-jobs)) + +(defun get-jobs (printer &key requested-attributes which-jobs completed + not-completed my-jobs limit) + (funcall printer :get-jobs + :requested-attributes requested-attributes + :which-jobs which-jobs + :completed completed + :not-completed not-completed + :my-jobs my-jobs + :limit limit)) + +(defun print-job (printer data-file &key job-name (ipp-attribute-fidelity t) + document-name document-format + document-natural-language compression + job-k-octets job-impressions + job-media-sheets copies sides) + (funcall printer :print-job data-file + :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 + :copies copies + :sides sides)) + +(defun validate-job (printer &key job-name (ipp-attribute-fidelity t) + document-name document-format + document-natural-language compression + job-k-octets job-impressions + job-media-sheets copies sides) + (funcall printer :validate-job + :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 + :copies copies + :sides sides)) + +(defun make-printer (ipp-client printer-uri request-file response-file @@ -480,180 +515,99 @@ &key (attributes-charset "utf-8") (attributes-natural-language "en") - (requesting-user-name (user-name)) - job-name - (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 - response-file - nil - request-id - :validate-job - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri) - (,(tag :job-attributes-tag) - :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 - :copies ,copies - :sides ,sides)))) - -(defun create-job (ipp-client - printer-uri - request-file - response-file - request-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en")) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :create-job - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri)))) - -;; TODO send-document - -(defun cancel-job (ipp-client - printer-uri - request-file - response-file - request-id - job-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name)) - message) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :cancel-job - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name - :job-id ,job-id - :message ,message)))) - -(defun get-job-attributes (ipp-client - printer-uri - request-file - response-file - request-id - job-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - limit - requested-attributes) - (assert (let ((x '(:job-template :job-description :all))) - (equal x (union x requested-attributes)))) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :get-job-attributes - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :job-id ,job-id - :limit ,limit - :requested-attributes ,requested-attributes)))) - -(defun get-jobs (ipp-client - printer-uri - request-file - response-file - request-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name)) - limit - requested-attributes - which-jobs - completed - not-completed - my-jobs) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :get-jobs - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name - :limit ,limit - :requested-attributes ,requested-attributes - :which-jobs ,which-jobs - :completed ,completed - :not-completed ,not-completed - :my-jobs ,my-jobs)))) - -(defun get-printer-attributes (ipp-client - printer-uri - request-file - response-file - request-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - limit - requested-attributes) - (assert (let ((x '(:job-template :printer-description :all))) - (equal x (union x requested-attributes)))) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :get-printer-attributes - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :limit ,limit - :requested-attributes ,requested-attributes)))) - -(defun hold-job (ipp-client + (requesting-user-name (user-name))) + (lambda (msg &rest args) + (flet ((%ipp (&optional oa ja data-file) + (ipp ipp-client printer-uri request-file response-file data-file + request-id msg + `((,(tag :operation-attributes-tag) + :attributes-charset ,attributes-charset + :attributes-natural-language ,attributes-natural-language + :requesting-user-name ,requesting-user-name + :printer-uri ,printer-uri + ,@oa) + (,(tag :job-attributes-tag) ,@ja))))) + (ecase msg + (:get-printer-attributes + (destructuring-bind (&key requested-attributes document-format + limit) args + #+nil ;; TODO sort + (assert (let ((x '(:job-template :printer-description :all))) + (equal x (union x requested-attributes)))) + (%ipp (list :requested-attributes requested-attributes + :document-format document-format + :limit limit)))) + ((:pause-printer :resume-printer :enable-printer :disable-printer + :create-job :purge-jobs) + ;; TODO check spec for :enable-printer and :disable-printer + (destructuring-bind () args + (%ipp))) + (:get-jobs + (destructuring-bind (&key requested-attributes which-jobs completed + not-completed my-jobs limit) args + (%ipp (list :requested-attributes requested-attributes + :which-jobs which-jobs + :completed completed + :not-completed not-completed + :my-jobs my-jobs + :limit limit)))) + (:print-job + (destructuring-bind (data-file + &key job-name (ipp-attribute-fidelity t) + document-name document-format + document-natural-language compression + job-k-octets job-impressions + job-media-sheets copies sides) args + (%ipp nil + (list :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 + :copies copies + :sides sides) + data-file))) + (:validate-job + (destructuring-bind (&key job-name (ipp-attribute-fidelity t) + document-name document-format + document-natural-language compression + job-k-octets job-impressions + job-media-sheets copies sides) args + (%ipp nil + (list :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 + :copies copies + :sides sides)))))))) + +(defun cancel-job (job &optional message) + (funcall job :cancel-job message)) + +(defun get-job-attributes (job &key requested-attributes limit) + (funcall job :get-job-attributes + :requested-attributes requested-attributes + :limit limit)) + +(defun hold-job (job &optional job-hold-until) + (funcall job :hold-job job-hold-until)) + +(defun restart-job (job &optional job-hold-until) + (funcall job :restart-job job-hold-until)) + +(defun release-job (job) + (funcall job :release-job)) + +(defun make-job (ipp-client printer-uri request-file response-file @@ -662,149 +616,45 @@ &key (attributes-charset "utf-8") (attributes-natural-language "en") - (requesting-user-name (user-name)) - job-hold-until) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :hold-job - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name - :job-id ,job-id - :job-hold-until ,job-hold-until)))) - -(defun release-job (ipp-client - printer-uri - request-file - response-file - request-id - job-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name))) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :release-job - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name - :job-id ,job-id)))) - -(defun restart-job (ipp-client - printer-uri - request-file - response-file - request-id - job-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name)) - job-hold-until) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :restart-job - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name - :job-id ,job-id - :job-hold-until ,job-hold-until)))) - -(defun pause-printer (ipp-client - printer-uri - request-file - response-file - request-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name))) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :pause-printer - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name)))) - -(defun resume-printer (ipp-client - printer-uri - request-file - response-file - request-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name))) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :resume-printer - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name)))) - -(defun purge-jobs (ipp-client - printer-uri - request-file - response-file - request-id - &key - (attributes-charset "utf-8") - (attributes-natural-language "en") - (requesting-user-name (user-name))) - (ipp ipp-client - printer-uri - request-file - response-file - nil - request-id - :purge-jobs - `((,(tag :operation-attributes-tag) - :attributes-charset ,attributes-charset - :attributes-natural-language ,attributes-natural-language - :printer-uri ,printer-uri - :requesting-user-name ,requesting-user-name)))) - -;; TODO set-job-attributes -;; TODO create-printer-subscription -;; TODO create-job-subscription -;; TODO get-subscription-attributes -;; TODO get-subscriptions -;; TODO renew-subscription -;; TODO cancel-subscription -;; TODO get-notifications -;; TODO enable-printer -;; TODO disable-printer + (requesting-user-name (user-name))) + (lambda (msg &rest args) + (flet ((%ipp (&optional attributes) + (ipp ipp-client printer-uri request-file response-file nil + request-id msg + `((,(tag :operation-attributes-tag) + :attributes-charset ,attributes-charset + :attributes-natural-language ,attributes-natural-language + :requesting-user-name ,requesting-user-name + :printer-uri ,printer-uri + :job-id ,job-id + ,@attributes))))) + (ecase msg + (:cancel-job + (destructuring-bind (&optional message) args + (%ipp (list :message message)))) + (:get-job-attributes + (destructuring-bind (&key requested-attributes limit) args + #+nil ;; TODO sort + (assert (let ((x '(:job-template :job-description :all))) + (equal x (union x requested-attributes)))) + (%ipp (list :requested-attributes requested-attributes + :limit limit)))) + ((:hold-job :restart-job) + (destructuring-bind (&optional job-hold-until) args + (%ipp (list :job-hold-until job-hold-until)))) + (:release-job + (destructuring-bind () args + (%ipp))))))) + +;; TODO send-document +;; TODO ? set-job-attributes +;; TODO ? create-printer-subscription +;; TODO ? create-job-subscription +;; TODO ? get-subscription-attributes +;; TODO ? get-subscriptions +;; TODO ? renew-subscription +;; TODO ? cancel-subscription +;; TODO ? get-notifications ;; TODO cups-get-default (defun cups-get-default (ipp-client @@ -927,18 +777,7 @@ :response-file response-file :content-type content-type)) -#+nil -(ipp:print-job 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - "test.txt" - 314) - -#+nil -(ipp:list-printers 'ipp-client - "http://localhost:631/printers/" - "printers.html") +;;(ipp:list-printers 'ipp-client "http://localhost:631/printers/" "printers.html") (defpackage :ipp.curl (:use :cl) @@ -968,88 +807,6 @@ :content-type content-type)) #+nil -(ipp:print-job 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - "test.txt" - 314 - :ipp-attribute-fidelity nil - :copies 2 - :sides "two-sided-long-edge" - ) - -#+nil -(ipp:validate-job 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - 314 - :ipp-attribute-fidelity nil - :copies 2 - :sides "two-sided-long-edge" - ) - -#+nil -(ipp:create-job 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "create-jobs.in" - "create-jobs.out" - 314) - -#+nil -(ipp:get-printer-attributes - 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - 314) - -#+nil -(ipp:get-printer-attributes ;; TODO fix - 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - 314 - :limit 2 - :requested-attributes '(:job-template :printer-description)) - -#+nil -(ipp:get-printer-attributes - 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - 314 - :limit 2 - :requested-attributes '(:all)) - -#+nil -(ipp:get-jobs 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - 314) - -#+nil -(ipp:get-jobs 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - 314 - :limit 2) - -#+nil -(ipp:get-jobs 'ipp-client - "http://localhost:631/printers/Virtual_PDF_Printer" - "request2.dat" - "response2.dat" - 314 - :limit 2 - :requested-attributes '(:job-id)) - -#+nil (ipp::cups-get-default 'ipp-client "http://localhost:631/printers/Virtual_PDF_Printer" "request2.dat" @@ -1063,7 +820,46 @@ "response2.dat" 314) -#+nil -(ipp:list-printers 'ipp-client - "http://localhost:631/printers/" - "printers.html") +;;(ipp:list-printers 'ipp-client "http://localhost:631/printers/" "printers.html") + +(let ((p (ipp:make-printer + 'ipp-client + "http://localhost:631/printers/Virtual_PDF_Printer" + "request2.dat" + "response2.dat" + 314))) + (ipp:get-printer-attributes p) + ;;(ipp:get-printer-attributes p :limit 2) + ;;(ipp:get-printer-attributes p requested-attributes '(:all)) + ;;TODO (ipp:get-printer-attributes p requested-attributes '(:printer-description)) + ;;TODO (ipp:get-printer-attributes p requested-attributes '(:job-template)) + ;;TODO (ipp:get-printer-attributes p requested-attributes '(:job-template :printer-description)) + ;;TODO login (ipp:pause-printer p) + ;;TODO login (ipp:resume-printer p) + ;;TODO login (ipp:enable-printer p) + ;;TODO login (ipp:disable-printer p) + ;;(ipp:create-job p) + ;;TODO login (ipp:purge-jobs p) + ;;(ipp:get-jobs p) + ;;(ipp:get-jobs p :limit 2) + ;;(ipp:get-jobs p :requested-attributes '(:job-id)) + ;;(ipp:get-jobs p :requested-attributes '(:job-description)) + ;;(ipp:get-jobs p :requested-attributes '(:job-id :job-description)) + ;;(ipp:get-jobs p :requested-attributes '(:all)) + ;;(ipp:print-job p "test.txt" :ipp-attribute-fidelity nil :copies 2 :sides "two-sided-long-edge") + ;;(ipp:validate-job p :ipp-attribute-fidelity nil :copies 2 :sides "two-sided-long-edge") + ) + +(let ((x (ipp:make-job + 'ipp-client + "http://localhost:631/printers/Virtual_PDF_Printer" + "request2.dat" + "response2.dat" + 314 + 100 #+nil"http://localhost:631/jobs/100"))) + (ipp:cancel-job x "cancelling from cl-ipp") + ;;(ipp:get-job-attributes x) + ;;(ipp:hold-job x) + ;;(ipp:restart-job x) + ;;(ipp:release-job x) + )