;;; -*- Mode:Common-Lisp; Package:NET; Base:10; Fonts:(COURIER TR12I TR12BI TR12 MEDFNTB) -*- ;1 File name: PRINT-SERVICE.LISP* ;1 This file defines a GNS called :PRINTER which replaces the old method of handling * ;1 Started 1-29-1989 by Eric Karlson, UC-Berkeley under Robert Wilensky* ;1 Phone: (415) 642-9076, E-mail Address: karlson@ucbarpa.berkeley.edu* ;1 Information on the LPD protocol came from the UNIX man pages and some code sent to me* ;1 by Brad Miller from the University of Rochester.* ;1 This defines the network service for manipulating printer queues on remote hosts. In order* ;1 to make use of this service the following services should be added to the appropriate hosts:* ; 1TCP: (:LPD :TCP-STREAM :UNIX-LPD)* ; 1CHAOS: (:LPD :CHAOS-STREAM :CHAOS-LPD)* ;1 The client side of the :LPD service is in buried in the general code for the printer. Generally,* ;1 you do not access this service directly. Look at the source code for printing and spooling files* ;1 to see which functions access this service.* ;1 The operations that the :LPD service knows about are:* ;1 :SPOOL, :STATUS & :CANCEL* ;1----------------* ;1 Local constants* ;1----------------* ;1; RDA: Changed "defconstant" to "defparameter" in the following 4 forms.* ;1; JWZ: Removed redundant *PRINTER-DIR* variable.* (defparameter 4*LPD-TIMEOUT** 600 "2Time to wait before timing out for an LPD connection in 60ths of a second.*") (defparameter 4*LPD-DATAFILE-MARK** 3 "2The Command byte to signal the start of the DataFile.*") (defparameter 4*LPD-COMFILE-MARK** 2 "2The Command byte to signal the start of the CommandFile.*") (defparameter 4*UNIX-LPD-COMMANDS** '((:SIMPLE . 1) (:SPOOL . 2) (:SHORT . 3) (:LONG . 4) (:REMOVE . 5)) "2An ALIST giving the UNIX LPD Command Numbers for different printer operations.*") ;1------------------* ;1 Utility Functions* ;1------------------* (defun 4unix-lpd-send-file* (marker size name file-stream unix-stream) "2Sends a file (accessed by an open stream) of the given size over to a UNIX machine, giving it the indicated name and marking the type of file transfered as given. The returned value indicates if it was successful.*" (declare (function unix-lpd-send-file (FIXNUM FIXNUM STRING STREAM STREAM) SYMBOL) (values SENT?)) (format unix-stream "3~C~D ~A~%*" (int-char marker) size name) (send unix-stream :force-output) (when (zerop (char-int (send unix-stream :tyi))) ;1 Stop translating characters to send literal printer commands.* (send unix-stream :suspend-output-translation) (stream-copy-until-eof file-stream unix-stream) (send unix-stream :tyo #\) (send unix-stream :force-output) ;1 Resume normal translation and read response from UNIX machine.* (send unix-stream :resume-output-translation) (zerop (char-int (send unix-stream :tyi))))) ;1----------------------------* ;1 Define the PRINTER service* ;1----------------------------* (define-service 4:LPD* (&rest args) (medium self args) "3Manipulates the Printer Queues on Remote Hosts*") (defflavor 4unix-lpd* ((name :unix-lpd) (desirability 0.75)) (service-implementation-mixin) :gettable-instance-variables :settable-instance-variables :initable-instance-variables (:documentation "3This is the implementation of the :LPD service for TCP connections.*")) (define-service-implementation 4'unix-lpd)* (define-logical-contact-name 4"3unix-lpd*"* '((:tcp 515))) (defmethod 4(unix-lpd :connect*) (medium host command &rest connect-args) "2Takes a local File Request and spools it to a remote TCP host. It returns a stream that can be read by the caller to determine the success of the attempt.*" (declare (function (:METHOD unix-lpd :connect) (MEDIUM HOST KEYWORD &rest LIST) STREAM) (values RESULT-STREAM)) ;1 Make sure that we are using some sort of BYTE STREAM.* (unless (superior-medium-p medium :BYTE-STREAM) (ferror 'gni-service-error "3Service ~A cannot connect using ~A medium*" self medium)) (do ((port *MAX-PRIV-PORT-NUM* (1- port)) (stream nil)) ((or stream (= port *MIN-PRIV-PORT-NUM*)) (or stream (ferror 'gni-service-error "3Service ~A could not allocate a Privileged Port using medium ~A to host ~A*" self medium host))) (declare (FIXNUM port) (type (or STREAM NULL) stream)) (setq stream (condition-case () (open-connection-on-medium host medium "3unix-lpd*" :connect-string (format nil "3~C~{~A~@[ ~]~}~%*" (int-char (sublis *UNIX-LPD-COMMANDS* command)) connect-args) :local-port port :stream-type :unix-translating-character-stream :timeout *LPD-TIMEOUT* :timeout-after-open nil :error T) (ip:connection-already-exists nil))))) (defmethod 4(unix-lpd :spool*) (medium host print-request) "2Takes a local File Request and spools it to a remote TCP host.*" ;1 Currently, the two problems are that the :PRINT-XXX-FILE methods for postscript printers* ;1 seem to send some garbage to the printer first (a PAGE and then lots of null bytes)* ;1 and the input does not start off with a `%!' which seems to be requred by the UNIX* ;1 end of the affair.* (declare (function (:METHOD unix-lpd :spool) (MEDIUM HOST printer:FILE-PRINT-REQUEST) T)) (let ((USER-ID "3PRINTER*") (*PRINT-PRETTY* nil) (*PRINT-BASE* 10) (*PRINT-RADIX* T) (*PRINT-LEVEL* nil) (*PRINT-LENGTH* nil)) (declare (special USER-ID *PRINT-PRETTY* *PRINT-BASE* *PRINT-RADIX* *PRINT-LEVEL* *PRINT-LENGTH*)) (with-open-stream (net-stream (send self :connect medium host :SPOOL (get (send print-request :print-device) :remote-name))) (declare (type STREAM net-stream)) (when (plusp (char-int (send net-stream :tyi))) (ferror 'gni-service-error "3LPD connection to ~A refused: ~A*" host (read-line net-stream nil "3[No Error Message Returned]*"))) ;1 Send over the file.* (let* ((sender-host (send print-request :sender-host)) (job (send print-request :request-no)) (queued-name (format nil "3A~3,48D~A*" job sender-host)) (control-name (string-append "3cf*" queued-name)) (data-name (string-append "3df*" queued-name)) ;1; jwz: compute directory instead of using *PRINTER-DIR** (temp-file (format nil "3~A~A*" (send (make-pathname :directory printer:*printer-directory-name* :host printer:*printer-file-host* :name nil :type nil :version nil) :merge-device) queued-name)) (file-name (send print-request :file-name)) (control-string "")) ;1 Dummy initial value.* (declare (type (or NULL HOST) sender-host) (FIXNUM job) (PATHNAME file-name) (STRING queued-name control-name control-string data-name temp-file)) ;1 Put the raw printer output into a file to copy over to the UNIX machine.* (unwind-protect (progn (with-open-file (tfs temp-file :direction :output :characters T :if-does-not-exist :create) (declare (STREAM tfs)) ;1 Now make the printer device.* (let* ((printer (send print-request :make-printer-device tfs))) (declare (type printer:BASIC-PRINTER printer)) ;1 Print header pages and the like.* (send printer :initialize-vars (if (send print-request :header) (or (send print-request :header-name) file-name)) (format nil "3~:[~A~;~A@~0@*~A~]*" sender-host (send print-request :user-name))) ;1 Get the control string.* (setq control-string (send printer :lpd-control-string data-name (send print-request :header-name) sender-host (send print-request :user-name) file-name (send print-request :copies))) ;1 Now read in the file to print.* (with-open-file (fd file-name :direction :input :characters T :error nil) (declare (STREAM fd)) (when (errorp fd) (ferror 'gni-service-error "3Service ~A unable to spool ~A: ~?*" self file-name (send fd :format-string) (send fd :format-args))) (if (send printer :screen-image-file-p file-name) (send printer :print-raw-file fd) (send printer :print-text-file fd (send print-request :font-list)))))) ;1 Now copy the temp file over to the UNIX host.* (with-open-file (tfs temp-file :direction :input :characters T) (declare (STREAM tfs)) (unless (unix-lpd-send-file *LPD-DATAFILE-MARK* (file-length tfs) data-name tfs net-stream) (ferror 'gni-service-error "3Service ~A unable to send Data File ~A to host ~A: ~A*" self temp-file host (read-line net-stream nil "3[No Error Message Returned]*"))))) ;1 Delete and Expunge the Temp File.* (delete-file temp-file :error nil) (send (pathname temp-file) :expunge :error nil)) ;1 Now send over the control file.* (unless (with-input-from-string (cstream control-string) (declare (STREAM cstream)) (unix-lpd-send-file *LPD-COMFILE-MARK* (length control-string) control-name cstream net-stream)) (ferror 'gni-service-error "3Service ~A unable to send Control File ~A to host ~A: ~A*" self control-name host (read-line net-stream nil "3[No Error Message Returned]*"))) ;1 Delete the file here if needed.* (when (send print-request :delete-after) (delete-file file-name :error nil) (send (pathname file-name) :expunge :error nil))) ;1 Close the network connection.* (send net-stream :eof)))) (defmethod 4(unix-lpd :status*) (medium host printer &optional (type :SHORT) (users ())) "2Checks the print spool on the given host.*" (declare (function (:METHOD unix-lpd :status) (MEDIUM HOST STRING &optional KEYWORD LIST) STRING) (values STATUS)) (let ((*PRINT-PRETTY* nil) (*PRINT-BASE* 10) (*PRINT-RADIX* T) (*PRINT-LEVEL* nil) (*PRINT-LENGTH* nil)) (declare (special *PRINT-PRETTY* *PRINT-BASE* *PRINT-RADIX* *PRINT-LEVEL* *PRINT-LENGTH*)) (with-open-stream (net-stream (cond ((eq type :QUEUE-STATUS-SIMPLE) (send self :connect medium host type (get (get-printer-device printer) :remote-name))) ( T (send self :connect medium host type (get (get-printer-device printer) :remote-name) (format nil "3~{~A~@[ ~]~}*" users))))) (declare (type STREAM net-stream)) (prog1 (with-output-to-string (stat) (declare (STREAM stat)) (stream-copy-until-eof net-stream stat)) ;1 Close the network connection.* (send net-stream :eof))))) (defmethod 4(unix-lpd :cancel*) (medium host printer job-number) "2Removes the indicated job from the remote queue. Returns the message from the remote host.*" (declare (function (:METHOD unix-lpd :cancel) (MEDIUM HOST STRING FIXNUM) STRING) (values REPLY-STRING)) (let ((*PRINT-PRETTY* nil) (*PRINT-BASE* 10) (*PRINT-RADIX* T) (*PRINT-LEVEL* nil) (*PRINT-LENGTH* nil)) (declare (special *PRINT-PRETTY* *PRINT-BASE* *PRINT-RADIX* *PRINT-LEVEL* *PRINT-LENGTH*)) (with-open-stream (net-stream (send self :connect medium host :REMOVE (get (get-printer-device printer) :remote-name) USER-ID job-number)) (declare (type STREAM net-stream)) (prog1 (with-output-to-string (stat) (declare (STREAM stat)) (stream-copy-until-eof net-stream stat)) ;1 Close the network connection.* (send net-stream :eof))))) (compile-flavor-methods unix-lpd) (defflavor 4chaos-lpd* ((name :chaos-lpd) (desirability 0.75)) (service-implementation-mixin) :gettable-instance-variables :settable-instance-variables :initable-instance-variables (:documentation "3This is the implementation of the :LPD service for CHAOS connections.*")) (define-service-implementation 4'chaos-lpd)* (define-logical-contact-name 4"3chaos-lpd*"* '((:chaos "3LPD*"))) (defmethod 4(chaos-lpd :connect*) (medium host command) "2Opens a connection to the LPD daemon on a CHAOS host. The command is sent over and the open connection is returned.*" (declare (function (:METHOD chaos-lpd :connect) (MEDIUM HOST STRING) STREAM) (values RESULT-STREAM)) ;1 Make sure that we are using some sort of BYTE STREAM.* (unless (superior-medium-p medium :BYTE-STREAM) (ferror 'gni-service-error "3Service ~A cannot connect using ~A medium*" self medium)) (open-connection-on-medium host medium "3chaos-lpd*" :connect-string command :stream-type :character-stream :timeout *LPD-TIMEOUT* :timeout-after-open nil :error nil)) (defmethod 4(chaos-lpd :spool*) (medium host print-request) "2Spools a file print request to another TI machine.*" (declare (function (:METHOD chaos-lpd :spool) (MEDIUM HOST printer:FILE-PRINT-REQUEST) STRING) (values RESULT-STRING)) (let ((*PRINT-PRETTY* nil) ;1Set up default parameters before sending* (*PRINT-BASE* 10) ;1request string to remote print server.* (*PRINT-RADIX* T) (*PRINT-LEVEL* nil) (*PRINT-LENGTH* nil) (USER-ID "3PRINTER*")) (declare (special *PRINT-PRETTY* *PRINT-RADIX* *PRINT-LEVEL* *PRINT-LENGTH* *PRINT-BASE* USER-ID)) (with-open-stream (net-stream (send self :connect medium host "3SPOOL*")) (declare (type STREAM net-stream)) (if (errorp net-stream) (ferror 'gni-service-error "3Error opening ~A LPD Server stream: ~?*" host (send net-stream :format-string) (send net-stream :format-args))) ;1 Check to make sure that it got the keyword.* (let ((resp (or (send net-stream :tyi) #\))) (declare (CHARACTER resp)) (selector resp char= (#\+ T) (#\- (ferror 'gni-service-error "3Failed to send SPOOL operation to ~A: ~A*" host (read-line net-stream nil "3[No Error Message Returned]*"))) (#\ (ferror 'gni-service-error "3Connection Closed to host ~A*" host)) (:Otherwise (ferror 'gni-service-error "3Unknown response from LPD Server on ~A: ~A*" host (read-line net-stream nil "3[No Error Message Returned]*"))))) ;1 Send over the spooling information.* (format net-stream "3~S~%*" (send print-request :fasd-form)) (send net-stream :force-output) ;1 Check the response.* (let ((resp (or (send net-stream :tyi) #\))) (declare (CHARACTER resp)) (selector resp char= (#\+ T) (#\- (ferror 'gni-service-error "3Negative response from LPD Server on ~A: ~A*" host (read-line net-stream nil "3[No Error Message Returned]*"))) (#\ (ferror 'gni-service-error "3Connection Closed to host ~A*" host)) (:Otherwise (ferror 'gni-service-error "3Unknown response from LPD Server on ~A: ~A*" host (read-line net-stream nil "3[No Error Message Returned]*")))) ;1 Close the stream.* (send net-stream :eof))))) (defmethod 4(chaos-lpd :status*) (medium host printer &optional (type :SHORT) users) "2Returns status information on a printer connected to a particular CHAOS host.*" (declare (function (:METHOD chaos-lpd :status) (MEDIUM HOST STRING &optional KEYWORD LIST) STRING) (values STATUS) (ignore users)) (let ((*PRINT-PRETTY* nil) ;1Set up default parameters before sending* (*PRINT-BASE* 10) ;1request string to remote print server.* (*PRINT-RADIX* T) (*PRINT-LEVEL* nil) (*PRINT-LENGTH* nil) (USER-ID "3PRINTER*")) (declare (special *PRINT-PRETTY* *PRINT-RADIX* *PRINT-LEVEL* *PRINT-LENGTH* *PRINT-BASE* USER-ID)) (with-open-stream (net-stream (send self :connect medium host (string type))) (declare (type STREAM net-stream)) (if (errorp net-stream) (ferror 'gni-service-error "3Error opening ~A Print Server stream: ~?*" host (send net-stream :format-string) (send net-stream :format-args))) ;1 See if the connection was accepted.* (let ((resp (or (send net-stream :tyi) #\))) (declare (CHARACTER resp)) (selector resp char= (#\+ T) (#\- (ferror 'gni-service-error "3Negative response from LPD Server on ~A: ~A*" host (read-line net-stream nil "3[No Error Message Returned]*"))) (#\ (ferror 'gni-service-error "3Connection Closed to host ~A*" host)) (:Otherwise (ferror 'gni-service-error "3Unknown response from LPD Server on ~A: ~A*" host (read-line net-stream nil "3[No Error Message Returned]*"))))) ;1 Send over the printer of interest.* (format net-stream "3~A*" printer) (send net-stream :force-output) ;1 Check the response.* (let ((resp (read-delimited-string #\End net-stream))) (declare (STRING resp)) ;1 Finish the stream* (send net-stream :eof) ;1 Now check the response.* (if (zerop (length resp)) (ferror 'gni-service-error "3Connection Closed to host ~A*" host) (selector (char resp 0) char= (#\+ (nsubstring resp 1)) (#\- (ferror 'gni-service-error "3Negative response from LPD Server on ~A: ~A*" host (nsubstring resp 1))) (:Otherwise (ferror 'gni-service-error "3Unknown response from LPD Server on ~A: ~A*" host resp)))))))) #| 3(defmethod (chaos-lpd :cancel) (medium host printer job-number) "Returns a response message from HOST to the request to delete print job JOB-NUMBER." (declare (function (:METHOD chaos-lpd :cancel) (MEDIUM HOST STRING FIXNUM) STRING)* 3 (values RESPONSE-STRING)) (let ((*PRINT-PRETTY* nil)* 3 ;Set up default parameters before sending* 3(*PRINT-BASE* 10)* 3 ;request string to remote print server.* 3(*PRINT-RADIX* T)* 3(*PRINT-LEVEL* nil)* 3(*PRINT-LENGTH* nil)* 3(USER-ID "PRINTER")) (declare (special *PRINT-PRETTY* *PRINT-RADIX* *PRINT-LEVEL* *PRINT-LENGTH* *PRINT-BASE* USER-ID)) (with-open-stream (net-stream (send self :connect medium host (sublis *TI-LPD-COMMANDS* :REMOVE))) (declare (type STREAM net-stream)) (if (errorp net-stream)* 3 (ferror gni-service-error "Error opening ~A Print Server stream: ~?"* 3 host* 3 (send net-stream :format-string)* 3 (send net-stream :format-args))) ; See if the connection was accepted. (let ((resp (send net-stream :line-in T)))* 3(declare (STRING resp))* 3(unless (char= #\+ (char resp 0))* 3 (ferror 'gni-service-error "Error in sending CANCEL keyword to ~A: ~A"* 3 host (nsubstring resp 1)))) ; Send over the spooling information. (format net-stream "~D~%" job-number) (send net-stream :force-output) ; Check the response. (let ((resp (send net-stream :line-in T)))* 3(declare (STRING resp))* 3; Finish the stream* 3(send net-stream :eof)* 3; Return the result message.* 3(selector (char resp 0) char=* 3 (#\+ (nsubstring resp 1))* 3 (#\- (ferror 'gni-service-error "Negative response from Print Server on ~A: ~A"* 3 host (nsubstring resp 1)))* 3 (:Otherwise (ferror 'gni-service-error "Unknown response from Print Server on ~A: ~A"* 3 host resp))))))) (compile-flavor-methods chaos-lpd) ;---------------------- ; Define the LPD server ;---------------------- (add-server-for-medium :BYTE-STREAM "unix-lpd"* 3 '(process-run-function "UNIX LPD Server" #'unix-lpd-server)) (defun unix-lpd-server () "Handles any TCP requests for remote print spooling/queue activites." (declare (function unix-lpd-server () T)) (let ((USER-ID "PRINTER")) (declare (special USER-ID)) (condition-case ()* 3(with-open-stream (server-stream (listen-for-connection-on-medium* 3 :byte-stream "unix-lpd"* 3 :stream-type :unix-translating-character-stream* 3 :timeout-after-open nil))* 3 (declare (STREAM server-stream))* 3 (let ((command (read-line server-stream nil "Unable to Read Server Stream")))* 3 (declare (STRING command))* 3 (case (char-int (char command 0))* 3 (1 )* 3 (2 )* 3 (3 )* 3 (4 )* 3 (5 )* 3 (Otherwise (ferror 'gni-service-error "Unknown LPD Connection Request from ~A: ~A"* 3 (send server-stream :foreign-host)* 3 command))))) (sys:NETWORK-ERROR nil))))* |# (add-server-for-medium :BYTE-STREAM "3chaos-lpd*" '(process-run-function "3CHAOS PRINTER Server*" #'chaos-lpd-server)) (defun 4chaos-lpd-server* () "2Handles any CHAOS requests for remote print spooling/queue activities.*" (declare (function chaos-lpd-server () T)) (let ((USER-ID "3PRINTER*")) (declare (special USER-ID)) (condition-case () (with-open-stream (server-stream (listen-for-connection-on-medium :byte-stream "3chaos-lpd*" :stream-type :character-stream :timeout-after-open nil)) (declare (STREAM server-stream)) (let ((command (get (locf (chaos:conn-plist (send server-stream :connection))) 'chaos:RFC-ARGUMENTS))) (declare (STRING command)) (selector command string= ("3SPOOL*" (send server-stream #\+) (send server-stream :force-output) (printer:receive-chaos-print-request server-stream)) (("3SIMPLE*" "3SHORT*" "3LONG*") (send server-stream #\+) (send server-stream :force-output) (printer:return-chaos-queue-info server-stream)) (:Otherwise (format server-stream "3-Unknown LPD Command: ~S~%*"3 *command) (send server-stream :eof))))) (sys:NETWORK-ERROR nil))))