/pliant/protocol/lpr/client.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	module "/pliant/language/unsafe.pli"
17	module "/pliant/language/context.pli"
18	module "/pliant/language/stream.pli"
19	module "/pliant/language/stream/openmode.pli"
20	module "/pliant/language/stream/multi.pli"
21	module "/pliant/language/stream/filesystembase.pli"
22	module "/pliant/admin/file.pli"
23
24	constant lpr_timeout 900 # default timeout is 15 minutes
25
26	(gvar TraceSlot lpr_trace) configure "LPR client"
27
28
29	type LprFileSystem
30	void
31	FileSystem maybe LprFileSystem
32
33	type LprStreamDriver
34	field Link:Stream tcp
35	field CBool direct nosize ; field Intn remain
36	field Str filename
37	field Link:Stream temp
38	field Str server id
39	StreamDriver maybe LprStreamDriver
40
41	method lpr write buf mini maxi -> written
42	arg_rw LprStreamDriver lpr ; arg Address buf ; arg Int mini maxi written
43	if lpr:direct
44	if lpr:nosize
45	written := maxi
46	eif lpr:remain>=maxi
47	written := maxi
48	eif lpr:remain>=mini
49	written := lpr remain
50	else
51	written := 0
52	lpr:tcp raw_write buf written
53	if lpr:tcp=failure
54	written := 0
55	lpr remain -= written
56	eif (exists lpr:temp)
57	lpr:temp raw_write buf maxi
58	written := shunt lpr:temp=success maxi 0
59	else
60	written := 0
61
62	method lpr flush level -> status
63	arg_rw LprStreamDriver lpr ; arg Int level ; arg Status status
64	if lpr:direct
65	lpr:tcp flush level
66	eif (exists lpr:temp)
67	lpr:temp flush level
68	status := success
69
70	method lpr query command stream answer -> status
71	oarg_rw LprStreamDriver lpr ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status
72	if command="seek" and not lpr:direct
73	stream flush anytime
74	status := lpr:temp:stream_driver query command lpr:temp answer
75	else
76	status := failure
77
78	method lpr configure command stream -> status
79	arg_rw LprStreamDriver lpr ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status
80	if (command parse word:"seek" (var Intn pos)) and not lpr:direct
81	stream flush anytime
82	status := lpr:temp:stream_driver configure command lpr:temp
83	else
84	status := failure
85
86	method lpr close -> status
87	arg_rw LprStreamDriver lpr ; arg ExtendedStatus status
88	var Pointer:Stream tcp :> lpr tcp
89	if lpr:direct
90	if not lpr:nosize and lpr:remain<>0
91	return failure:"Too fiew bytes written"
92	eif (exists lpr:temp)
93	lpr:temp close
94	var FileInfo info := file_query lpr:filename standard
95	var uInt8 cmd8 := 3 ; tcp raw_write addressof:cmd8 1
96	tcp writeline (string info:size)+" dfa"+lpr:id+computer_name
97	tcp raw_read addressof:(var uInt8 ack) 1
98	if ack<>0
99	file_delete lpr:filename
100	lpr_trace trace "'" lpr:server "' does not want to receive print data file"
101	return (failure "'"+lpr:server+"' does not want to receive print data file")
102	(var Stream s) open lpr:filename in
103	while (raw_copy s tcp 1 2^24)>0
104	void
105	s close
106	file_delete lpr:filename
107	if not lpr:nosize
108	var uInt8 cmd8 := 0 ; tcp raw_write addressof:cmd8 1
109	tcp raw_read addressof:(var uInt8 ack) 1
110	if ack<>0
111	lpr_trace trace "server failed to receive data file (" (cast ack Int) ")"
112	return (failure "server failed to receive data file ("+string:(cast ack Int)+")")
113	status := tcp close
114
115	gvar Int counter := -1
116
117	method fs open name options flags stream support -> status
118	arg_rw LprFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
119	if (name eparse "//" any:(var Str server) "/" any:(var Str queue) "/" any:(var Str file))
120	void
121	eif (name eparse "//" any:(var Str server) "/" any:(var Str queue))
122	file := ""
123	else
124	return failure:"Incorrect name"
125	var Int port
126	if (server parse any:(var Str remain) ":" port)
127	server := remain
128	else
129	port := 515
130	if (flags .and. in_out)<>out
131	return failure:"The only supported mode for LPR client is 'out'"
132	var Intn size := options option "file_size" Intn
133	var Link:Stream tcp :> new Stream
134	var Int lap := 1
135	part select_id
136	tcp open "tcp://"+server+"/client/"+string:port in+out+safe
137	if tcp=failure
138	lpr_trace trace "Failed to connect to '" server "' LPR port"
139	return (failure "Failed to connect to '"+server+"' LPR port")
140	tcp configure "timeout "+string:(options option "timeout" Int lpr_timeout)
141	var uInt8 cmd8 := 2 ; tcp raw_write addressof:cmd8 1
142	tcp writeline (shunt queue<>"" queue "lp")
143	tcp raw_read addressof:(var uInt8 ack) 1
144	if ack<>0
145	lpr_trace trace "'" server "' does not want to receive a print job"
146	return (failure "'"+server+"' does not want to receive a print job")
147	counter := (counter+1)%1000
148	var Str id := right string:counter 3 "0"
149	var Str control := "H"+computer_name+"[lf]P"+(options option "user" Str "Pliant")+"[lf]"+(options option "lpr_format" Str "l")+"dfa"+id+computer_name+"[lf]Udfa"+id+computer_name+"[lf]J"+(options option "title" Str)+(shunt file<>"" "[lf]N"+file "")+"[lf]"
150	var uInt8 cmd8 := 2 ; tcp raw_write addressof:cmd8 1
151	tcp writeline (string control:len)+" cfa"+id+computer_name
152	tcp raw_read addressof:(var uInt8 ack) 1
153	if ack<>0 and lap<1000
154	lap += 1
155	restart select_id
156	if ack<>0
157	lpr_trace trace "'" server "' does not want to receive print control file"
158	return (failure "'"+server+"' does not want to receive print control file")
159	tcp writechars control
160	var uInt8 cmd8 := 0 ; tcp raw_write addressof:cmd8 1
161	tcp raw_read addressof:(var uInt8 ack) 1
162	if ack<>0
163	lpr_trace trace "'" server "' failed to receive print control file (" (cast ack Int) ")"
164	return (failure "'"+server+"' failed to receive print control file ("+string:(cast ack Int)+")")
165	var Link:LprStreamDriver lpr :> new LprStreamDriver
166	lpr tcp :> tcp
167	if (size<>undefined or (options option "lprng")) and (flags .and. seek)=0
168	lpr direct := true
169	lpr remain := size
170	lpr nosize := size=undefined
171	var uInt8 cmd8 := 3 ; tcp raw_write addressof:cmd8 1
172	tcp writeline string:(shunt size=undefined 0 size)+" dfa"+id+computer_name
173	tcp raw_read addressof:(var uInt8 ack) 1
174	if ack<>0 and lap<1000
175	var uInt8 cmd8 := 1 ; tcp raw_write addressof:cmd8 1
176	tcp writeline ""
177	tcp raw_read addressof:(var uInt8 ack) 1
178	if ack=0
179	lap += 1
180	restart select_id
181	if ack<>0
182	lpr_trace trace "'" server "' does not want to receive print data file"
183	return (failure "'"+server+"' does not want to receive print data file")
184	else
185	lpr direct := false
186	lpr nosize := false
187	lpr filename := file_temporary
188	lpr temp :> new Stream
189	lpr:temp open lpr:filename out+(flags .and. safe)
190	lpr server := server
191	lpr id := id
192	stream stream_driver :> lpr
193	lpr_trace trace "print job queued on '"+server+"' in queue '"+queue+"'"
194	status := success
195
196	gvar LprFileSystem lpr_file_system
197	pliant_multi_file_system mount "lpr:" "" lpr_file_system
198	pliant_multi_file_system mount "lprng:" "" "lprng" lpr_file_system