/pliant/util/crypto/channel.pli
1	abstract
2	[This is complete secured channel implementation, but it's not because:] ; eol
3	list
4	item [it has not been seriously review yet.]
5	item [the memory buffer might not be properly cleared before beeing freed.]
6
7	doc
8	[It uses RSA public/private key pairs for exchanging a secret shared key.] ; eol
9	[All informations on the secured chanel are MD5 signed, then RC4 ciphered. ]
10
11	constant server_seed_bits 128
12	constant server_rc4_laps 10
13	constant client_seed_bits 128
14	constant client_rc4_laps 10
15	constant backward_compatibility true
16
17	module "/pliant/language/compiler.pli"
18	module "random.pli"
19	module "rsa.pli"
20	module "rc4.pli"
21	module "cipher.pli"
22	module "/pliant/admin/md5.pli"
23	module "/pliant/util/encoding/base64.pli"
24	module "/pliant/language/type/text/str8.pli"
25	module "/pliant/util/encoding/html.pli"
26	module "/pliant/protocol/dns/name.pli"
27	module "/pliant/protocol/http/site.pli"
28	module "/pliant/fullpliant/user.pli"
29
30	module "/pliant/language/stream/filesystembase.pli"
31	module "/pliant/language/stream/openmode.pli"
32	module "/pliant/language/stream/flushmode.pli"
33	module "/pliant/language/stream.pli"
34	module "/pliant/language/stream/multi.pli"
35
36	(gvar TraceSlot server_trace) configure "secured channel server"
37	(gvar TraceSlot client_trace) configure "secured channel client"
38
39
40	function random_seed len -> s
41	arg Int len ; arg Str s
42	var DateTime dt := datetime
43	var Str timestamp := repeat DateTime:size " "
44	memory_copy addressof:dt timestamp:characters DateTime:size
45	part generate
46	s := timestamp+random_string:(max len-DateTime:size 1)
47	if (s s:len-1):number=0
48	restart generate
49
50
51
52
53
54	type SecuredStreamDriver
55	field Link:Stream s
56	field RC4Ctx read_ctx
57	field Str read_buffer
58	field CBool read_crashed <- false
59	field RC4Ctx write_ctx
60	field CBool write_crashed <- false
61	field Str local_site
62	field Str local_user
63	field Str remote_site
64	field Str remote_user
65	field Int security_level
66	field Str errmsg
67	field Str wrong_block
68	field Str encoding
69	StreamDriver maybe SecuredStreamDriver
70
71
72	doc
73	[Read RC4 ciphered bytes.]
74
75	method drv read1 buf size -> status
76	arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int size ; arg Status status
77	var Int red := 0
78	while red<size
79	drv:s read_available (var Address adr) (var Int step) size-red
80	if step=0
81	return failure
82	rc4_cipher drv:read_ctx adr (buf translate Byte red) step
83	red += step
84	status := success
85
86	doc
87	[Read MD5 signed packets.] ; eol
88	['read_buffer' contains the bytes from the last packet that have not yet been consumed.]
89
90	method drv read buf mini maxi -> red
91	arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int mini maxi red
92	red := 0
93	if drv:read_crashed
94	return
95	while red<mini
96	if drv:read_buffer:len>0
97	var Int step := min drv:read_buffer:len maxi
98	memory_copy drv:read_buffer:characters (buf translate Byte red) step
99	drv:read_buffer := drv:read_buffer step drv:read_buffer:len
100	red += step
101	else
102	if (drv read1 addressof:(var uInt16_li step16) uInt16:size)=failure
103	drv errmsg := "read block size"
104	drv read_crashed := true ; return
105	drv:read_buffer set (memory_allocate step16 (addressof drv:read_buffer)) step16 true
106	if (drv read1 drv:read_buffer:characters step16)=failure
107	drv errmsg := "read block data"
108	drv read_crashed := true ; return
109	var Str correct := string_md5_binary_signature drv:read_buffer
110	(var Str provided) set (memory_allocate correct:len addressof:provided) correct:len true
111	if (drv read1 provided:characters provided:len)=failure
112	drv errmsg := "read block signature"
113	drv read_crashed := true ; return
114	if provided<>correct
115	drv wrong_block := drv read_buffer
116	drv errmsg := "wrong block signature"
117	drv read_crashed := true ; return
118
119
120	doc
121	[Writes RC4 ciphered bytes.]
122
123	method drv write1 buf size -> status
124	arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int size ; arg Status status
125	var Int written := 0
126	while written<size
127	var Int step := min (cast drv:s:stream_write_stop Int).-.(cast drv:s:stream_write_cur Int) size-written
128	rc4_cipher drv:write_ctx (buf translate Byte written) drv:s:stream_write_cur step
129	drv:s stream_write_cur := drv:s:stream_write_cur translate Byte step
130	if drv:s:stream_write_cur=drv:s:stream_write_stop
131	drv:s flush anytime
132	if drv:s:is_crashed
133	return failure
134	written += step
135	status := success
136
137	doc
138	[Writes MD5 signed packets.]
139
140	method drv write buf mini maxi -> written
141	arg_rw SecuredStreamDriver drv ; arg Address buf ; arg Int mini maxi written
142	written := 0
143	if drv:write_crashed
144	return
145	while written<mini
146	var uInt16_li step16 := min maxi-written 2^16-1
147	if (drv write1 addressof:step16 uInt16:size)=failure
148	drv errmsg := "write block size"
149	drv write_crashed := true ; return
150	if (drv write1 (buf translate Byte written) step16)=failure
151	drv errmsg := "write block data"
152	drv write_crashed := true ; return
153	(var Str temp) set (buf translate Byte written) step16 false
154	var Str digest := string_md5_binary_signature temp
155	if (drv write1 digest:characters digest:len)=failure
156	drv errmsg := "write block signature"
157	drv write_crashed := true ; return
158	written += step16
159
160
161	method drv flush level -> status
162	arg_rw SecuredStreamDriver drv ; arg Int level ; arg Status status
163	if level<>end
164	drv:s flush level
165	status := shunt drv:s=success success failure
166
167
168	method drv query command stream answer -> status
169	arg_rw SecuredStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status
170	if command="local_site"
171	answer := drv local_site
172	status := success
173	eif command="local_user"
174	answer := drv local_user
175	status := success
176	eif command="remote_site"
177	answer := drv remote_site
178	status := success
179	eif command="remote_user"
180	answer := drv remote_user
181	status := success
182	eif command="security_level"
183	answer := string drv:security_level
184	status := success
185	eif command="error_message"
186	answer := drv errmsg
187	status := success
188	eif command="wrong_block"
189	answer := drv wrong_block
190	status := success
191	eif command="encoding"
192	answer := drv encoding
193	status := success
194	else
195	status := drv:s:stream_driver query command drv:s answer
196
197
198	method drv configure command stream -> status
199	arg_rw SecuredStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status
200	status := drv:s:stream_driver configure command drv:s
201
202
203
204
205
206	doc
207	[Exchange a new shared secret key between the client and the server.] ; eol
208	list
209	item [The client will generate a seed and send it to the server, ciphered with the server public key (1)]
210	item [The server will reply with a seed of it's own, ciphered with the client public key (2a)]
211	item [Then the server will send the client seed, ciphered with the client public key (2b)]
212	item [The client will check it's own seed sent back by the server: the server identity is proved]
213	item [Then the client will send the server seed, ciphered with the server public key (3)]
214	item [The server will check it's own seed sent back by the client: the client identity is proved]
215	item [The new shared secret is the client seed followed by the server seed.]
216
217
218	function server_exchange_key s server_site client_site client_user log -> key
219	arg_rw Stream s ; arg Str server_site client_site client_user ; arg_rw TraceSession log ; arg Str key
220	var Str server_public := name_database:data:host:server_site public_key
221	var Str server_private := name_secret_database:data:host:server_site private_key
222	var CBool is_host := true
223	if server_public=""
224	server_public := site:server_site public_key
225	server_private := site_secret_database:data:site:server_site private_key
226	is_host := false
227	if server_public="" or server_private=""
228	log trace "missing server key (server_exchange_key)."
229	return ""
230	var Str client_public
231	if client_site<>""
232	client_public := name_database:data:host:client_site public_key
233	if client_public=""
234	client_public := site:client_site public_key
235	eif client_user<>""
236	client_public := user:client_user public_key
237	if client_public=""
238	log trace "missing client key (server_exchange_key)."
239	return ""
240	# wait for the client seed
241	var Str client_key := ""
242	while not s:atend and { var Str l := s:readline ; l<>"" }
243	if (l parse "key:" any:(var Str encoded))
244	client_key := rsa_cipher base64_decode:encoded server_private
245	if client_key=""
246	log trace "wrong client seed (server_exchange_key)."
247	return ""
248	# send the server seed
249	var Str server_key := random_string (max rsa_nbbits:server_public rsa_nbbits:client_public)\8
250	s writeline "key: "+base64_encode:(rsa_cipher server_key client_public)
251	# send the client seed back
252	s writeline "sign-rsa: "+base64_encode:(rsa_cipher client_key client_public)
253	s writeline "" ; s flush anytime
254	# wait for the server seed back
255	var Str back := ""
256	while not s:atend and { var Str l := s:readline ; l<>"" }
257	if (l parse "sign-rsa:" any:(var Str encoded))
258	back := rsa_cipher base64_decode:encoded server_private
259	if back<>server_key
260	# client answer is wrong (server seed back)
261	log trace "wrong client answer (server_exchange_key)."
262	return ""
263	key := client_key+server_key
264	# stores the new shared key in the users database
265	var Str client_id := shunt client_site<>"" client_site client_user
266	if is_host
267	name_secret_database:data:host:server_site:session create client_id
268	name_secret_database:data:host:server_site:session:client_id:key := straight_to_Str8 key
269	name_secret_database:data:host:server_site:session:client_id:timestamp := datetime
270	name_secret_database store
271	else
272	site_secret_database:data:site:server_site:session create client_id
273	site_secret_database:data:site:server_site:session:client_id:key := straight_to_Str8 key
274	site_secret_database:data:site:server_site:session:client_id:timestamp := datetime
275	site_secret_database store
276
277
278	function client_exchange_key s server_site client_site client_user password log -> key
279	arg_rw Stream s ; arg Str server_site client_site client_user password ; arg_rw TraceSession log ; arg Str key
280	var Str server_public := name_database:data:host:server_site public_key
281	var CBool is_host := true
282	if server_public=""
283	server_public := site:server_site public_key
284	is_host := false
285	if server_public=""
286	log trace "missing server key (client_exchange_key)."
287	return ""
288	var Str client_public client_private
289	if client_site<>""
290	client_public := name_database:data:host:client_site public_key
291	client_private := name_secret_database:data:host:client_site private_key
292	if client_public=""
293	client_public := site:client_site public_key
294	client_private := site_secret_database:data:site:client_site private_key
295	eif client_user<>""
296	client_public := user:client_user public_key
297	client_private := uncipher straight_to_Str:(user_secret_database:data:user:client_user private_key) password
298	if client_public="" or client_private=""
299	log trace "missing client key (client_exchange_key)."
300	return ""
301	var Str client_key := random_string (max rsa_nbbits:server_public rsa_nbbits:client_public)\8
302	s writeline "key: "+base64_encode:(rsa_cipher client_key server_public)
303	s writeline "" ; s flush anytime
304	# send the client seed
305	# wait for the server seed and the client seed back
306	var Str server_key := ""
307	var Str back := ""
308	while not s:atend and { var Str l := s:readline ; l<>"" }
309	if (l parse "sign-rsa:" any:(var Str encoded))
310	back := rsa_cipher base64_decode:encoded client_private
311	if (l parse "key:" any:(var Str encoded))
312	server_key := rsa_cipher base64_decode:encoded client_private
313	if server_key="" or back<>client_key
314	# server answer is wrong (client seed back)
315	log trace "wrong server answer (client_exchange_key)."
316	return ""
317	# send the server seed back
318	s writeline "sign-rsa: "+base64_encode:(rsa_cipher server_key server_public)
319	s writeline "" ; s flush anytime
320	key := client_key+server_key
321	# stores the new shared key in the users database
322	if client_site<>"" and is_host
323	name_secret_database:data:host:client_site:session create server_site
324	name_secret_database:data:host:client_site:session:server_site:key := straight_to_Str8 key
325	name_secret_database:data:host:client_site:session:server_site:timestamp := datetime
326	name_secret_database store
327	eif client_site<>"" and not is_host
328	site_secret_database:data:site:client_site:session create server_site
329	site_secret_database:data:site:client_site:session:server_site:key := straight_to_Str8 key
330	site_secret_database:data:site:client_site:session:server_site:timestamp := datetime
331	site_secret_database store
332	else
333	user_secret_database:data:user:client_user:session create server_site
334	user_secret_database:data:user:client_user:session:server_site:key := straight_to_Str8 (cipher key password)
335	user_secret_database:data:user:client_user:session:server_site:timestamp := datetime
336	user_secret_database store
337
338
339
340
341	doc
342	[Open a new secured channel.] ; eol
343	list
344	item [The client will send a seed (1)]
345	item [The server will send a seed (2a)]
346	item [The server will answer with a MD5 digest of the shared secret + client seed (2b)]
347	item [The client will answer with a MD5 digest of server seed + shared secret (3)]
348	item [Both sides check the MD5 answers, and a new shared secret is negociated if they where wrong or there was no shared secret yet.]
349	[The server will cipher using RC4 and the key will be client seed + shared secret + server seed] ; eol
350	[The client will cipher using RC4 and the key will be server seed + shared secret + client seed]
351
352
353	type SecuredFileSystem
354	void
355	FileSystem maybe SecuredFileSystem
356
357	function open_server_channel port log options flags stream support -> status
358	arg Int port ; arg_rw TraceSession log ; arg Str options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
359	log bind server_trace
360	# this is the server side: this code is executed on the server when a client is asking for a secured channel
361	var Link:Stream s
362	if addressof:support<>null
363	s :> support
364	else
365	var Link:Stream s :> new Stream
366	s open "tcp:/server/"+string:port "" in+out+(flags .and. safe)
367	if s=failure
368	log trace "Failed to connect to " s:name
369	return (failure "failed to listen TCP port "+string:port)
370	# receive the client seed
371	var Str server_site := ""
372	var Str client_site := ""
373	var Str client_user := ""
374	var Str client_seed := ""
375	var Int client_laps := undefined
376	var CBool query_client := false
377	var CBool query_server := false
378	var Str encoding := ""
379	while not s:atend and { var Str l := s:readline ; l<>"" }
380	if (l parse "server-site:" any:(var Str encoded))
381	server_site := base64_decode encoded
382	eif backward_compatibility and (l parse "server-user:" any:(var Str encoded))
383	server_site := base64_decode encoded
384	eif (l parse "client-site:" any:(var Str encoded))
385	client_site := base64_decode encoded
386	eif (l parse "client-user:" any:(var Str encoded))
387	client_user := base64_decode encoded
388	eif (l parse "seed-rc4:" any:(var Str encoded))
389	client_seed := base64_decode encoded
390	eif (l parse "laps-rc4:" (var Int i))
391	client_laps := i
392	eif (l parse "query-client-key")
393	query_client := true
394	eif (l parse "query-server-key")
395	query_server := true
396	eif (l parse "encoding:" any:(var Str enc)) and (enc="deflate" or enc="zlib")
397	encoding := enc
398	if query_client
399	if client_site<>""
400	var Str client_public := name_database:data:host:client_site public_key
401	if client_public=""
402	client_public := site:client_site public_key
403	s writeline "client-key: "+client_public
404	else
405	var Str client_public := user:client_user public_key
406	s writeline "client-key: "+client_public
407	if query_server
408	var Str server_public := name_database:data:host:server_site public_key
409	if server_public<>""
410	if not (server_public parse word:"rsa" _ any:(var Str part1a) _ any ) or not (name_secret_database:data:host:server_site:private_key parse word:"rsa" _ any:(var Str part1b) _ any) or part1a<>part1b
411	server_public := "corrupted key"
412	else
413	server_public := site:server_site public_key
414	if server_public<>""
415	if not (server_public parse word:"rsa" _ any:(var Str part1a) _ any ) or not (site_secret_database:data:site:server_site:private_key parse word:"rsa" _ any:(var Str part1b) _ any) or part1a<>part1b
416	server_public := "corrupted key"
417	s writeline "server-key: "+server_public
418	if encoding<>""
419	s writeline "encoding: "+encoding
420	log trace "secured server: connection from " (shunt client_site<>"" "site "+client_site "user "+client_user) " to site " server_site
421	if client_seed="" or client_laps=undefined
422	log trace "wrong client seed or laps."
423	return failure
424	if name_secret_database:data:host:server_site:private_key="" and site_secret_database:data:site:server_site:private_key=""
425	log trace "no private key for " server_site
426	return failure
427	# send server seed
428	var Str server_seed := random_seed server_seed_bits\8
429	var Int server_laps := server_rc4_laps
430	s writeline "seed-rc4: "+base64_encode:server_seed
431	s writeline "laps-rc4: "+string:server_laps
432	# retreive the shared secret with this client (may be empty if they never talked together or the sever discarded it)
433	var Str key := straight_to_Str name_secret_database:data:host:server_site:session:(shunt client_site<>"" client_site client_user):key
434	if key=""
435	key := straight_to_Str site_secret_database:data:site:server_site:session:(shunt client_site<>"" client_site client_user):key
436	# send MD5 digest of shared secret + client seed
437	s writeline "sign-md5: "+base64_encode:(string_md5_binary_signature key+client_seed)
438	s writeline ""
439	# wait for the MD5 digest of server seed + shared secret
440	var Str back := ""
441	while not s:atend and { var Str l := s:readline ; l<>"" }
442	if (l parse "sign-md5:" any:(var Str encoded))
443	back := base64_decode encoded
444	if back<>(string_md5_binary_signature server_seed+key) or key=""
445	# the MD5 was wrong or there was no shared secret: we must negotiate a new one using RSA keys
446	log trace "secured server: needs to exchange a shared key."
447	part exchange "exchange secret keys"
448	key := server_exchange_key s server_site client_site client_user log
449	if key=""
450	log trace "failed to exchange a shared key."
451	return failure
452	log trace "secured server: session opened (" key:len ")."
453	var Link:SecuredStreamDriver drv :> new SecuredStreamDriver
454	if (flags .and. out)<>0
455	rc4_init drv:write_ctx client_seed+key+server_seed server_laps
456	if (flags .and. in)<>0
457	rc4_init drv:read_ctx server_seed+key+client_seed client_laps
458	drv local_site := server_site
459	if client_site<>""
460	drv remote_site := client_site
461	eif client_user<>""
462	drv remote_user := client_user
463	drv security_level := min (rsa_nbbits site:server_site:public_key) (shunt client_site<>"" (rsa_nbbits site:client_site:public_key) (rsa_nbbits user:client_user:public_key))
464	log trace "secured server: security level is " drv:security_level " bits"
465	drv s :> s
466	if encoding<>""
467	log trace "secured server: encoding is " encoding
468	drv encoding := encoding
469	var Link:Stream zs :> new Stream
470	if (zs open "null:" options flags)=failure
471	return failure
472	zs stream_driver :> drv
473	if (pliant_default_file_system open encoding+":" options flags stream zs)=failure
474	return failure
475	else
476	stream stream_driver :> drv
477	status := success
478	log trace "secured channel " server_site " <- " (shunt client_site<>"" "site "+client_site "user "+client_user)
479
480	function open_client_channel server_site client_site client_user password port log options flags stream support -> status
481	arg Str server_site client_site client_user password ; arg Int port ; arg_rw TraceSession log ; arg Str options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
482	# this is the client side: this code is executed on the client when trying to get a secured channel to a server
483	log bind client_trace
484	var Link:Stream s
485	if addressof:support<>null
486	s :> support
487	else
488	var Link:Stream s :> new Stream
489	s open "tcp://"+server_site+"/client/"+string:port "" in+out+(flags .and. safe)
490	if s=failure
491	log trace "failed to connect to " s:name
492	return (failure "failed to connect to '"+server_site+"' TCP port "+string:port)
493	# send a seed
494	var Str client_seed := random_seed client_seed_bits\8
495	var Int client_laps := client_rc4_laps
496	s writeline "server-site: "+base64_encode:server_site
497	if backward_compatibility
498	s writeline "server-user: "+base64_encode:server_site
499	if client_site<>""
500	s writeline "client-site: "+base64_encode:client_site
501	eif client_user<>""
502	s writeline "client-user: "+base64_encode:client_user
503	s writeline "seed-rc4: "+base64_encode:client_seed
504	s writeline "laps-rc4: "+string:client_laps
505	if (options option "query_server_key")
506	s writeline "query-server-key"
507	if (options option "query_client_key")
508	s writeline "query-client-key"
509	if (options option "deflate")
510	s writeline "encoding: deflate"
511	eif (options option "zlib")
512	s writeline "encoding: zlib"
513	s writeline ""
514	# receive MD5 digest of shared secret + client seed
515	# also receive the server seed
516	var Str back := ""
517	var Str server_seed := ""
518	var Int server_laps := undefined
519	var Str encoding := ""
520	while not s:atend and { var Str l := s:readline ; l<>"" }
521	if (l parse "sign-md5:" any:(var Str encoded))
522	back := base64_decode:encoded
523	eif (l parse "seed-rc4:" any:(var Str encoded))
524	server_seed := base64_decode:encoded
525	eif (l parse "laps-rc4:" (var Int i))
526	server_laps := i
527	eif (l parse "encoding:" any:(var Str enc)) and (enc="deflate" or enc="zlib")
528	encoding := enc
529	log trace encoding+" encoding accepted."
530	log trace "secured client: new connection from " (shunt client_site<>"" "site "+client_site "user "+client_user) " to " server_site
531	if server_seed="" or server_laps=undefined
532	log trace "wrong server seed or laps."
533	return failure
534	# retreive the shared secret with this client (may be empty if they never talked together or the sever discarded it)
535	var Str key
536	if client_site<>""
537	key := straight_to_Str name_secret_database:data:host:client_site:session:server_site:key
538	if key=""
539	key := straight_to_Str site_secret_database:data:site:client_site:session:server_site:key
540	eif client_user<>""
541	key := uncipher (straight_to_Str user_secret_database:data:user:client_user:session:server_site:key) password
542	# send MD5 digest of server seed + shared secret
543	s writeline "sign-md5: "+base64_encode:(string_md5_binary_signature server_seed+key)
544	s writeline ""
545	if back<>(string_md5_binary_signature key+client_seed) or key=""
546	# the MD5 was wrong or there was no shared secret: we must negotiate a new one using RSA keys
547	log trace "needs to exchange a shared key."
548	key := client_exchange_key s server_site client_site client_user password log
549	if key=""
550	log trace "failed to exchange a shared key."
551	return failure
552	log trace "session opened (" key:len ")."
553	var Link:SecuredStreamDriver drv :> new SecuredStreamDriver
554	if (flags .and. out)<>0
555	rc4_init drv:write_ctx server_seed+key+client_seed client_laps
556	if (flags .and. in)<>0
557	rc4_init drv:read_ctx client_seed+key+server_seed server_laps
558	if client_site<>""
559	drv local_site := client_site
560	eif client_user<>""
561	drv local_user := client_user
562	drv remote_site := server_site
563	drv security_level := min (rsa_nbbits site:server_site:public_key) (shunt client_site<>"" (rsa_nbbits site:client_site:public_key) (rsa_nbbits user:client_user:public_key))
564	log trace "security level is " drv:security_level " bits"
565	drv s :> s
566	if encoding<>""
567	log trace "encoding is " encoding
568	drv encoding := encoding
569	var Link:Stream zs :> new Stream
570	if (zs open "null:" options flags)=failure
571	return failure
572	zs stream_driver :> drv
573	if (pliant_default_file_system open encoding+":" options flags stream zs)=failure
574	return failure
575	else
576	stream stream_driver :> drv
577	status := success
578
579	method fs open name options flags stream support -> status
580	arg_rw SecuredFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
581	var TraceSession log
582	if (name parse "/server/" (var Int port))
583	status := open_server_channel port log options flags stream support
584	eif (name parse "//" any:(var Str server_site) "/user/" (var Int port) "/" any:(var Str client_user) "/" any:(var Str password))
585	status := open_client_channel server_site "" client_user password port log options flags stream support
586	eif (name parse "//" any:(var Str server_site) "/site/" (var Int port) "/" any:(var Str client_site))
587	status := open_client_channel server_site client_site "" "" port log options flags stream support
588	eif backward_compatibility and (name parse "//" any:(var Str site) "/client/" (var Int port) "/" any:(var Str server_site) "/" any:(var Str client_user) "/" any:(var Str password)) and site=server_site
589	status := open_client_channel server_site client_site client_user password port log options flags stream support
590	else
591	status := failure
592
593
594	method fs query filename options flags info -> status
595	arg_rw SecuredFileSystem fs ; arg Str filename options ; arg Int flags ; arg_rw FileInfo info ; arg ExtendedStatus status
596	if backward_compatibility and (filename parse "//" any:(var Str site) "/client/" (var Int port) "/" any:(var Str server_site) "/" any:(var Str client_user) "/" any:(var Str password))
597	(var Stream s) open "tcp://"+site+"/client/"+string:port "" in+out+(flags .and. safe+noautopost)
598	if s=failure
599	return failure
600	s writeline "server-site: "+base64_encode:server_site
601	s writeline "client-user: "+base64_encode:client_user
602	s writeline "query-server-key"
603	s writeline "query-client-key"
604	s writeline ""
605	var Str answer := ""
606	while not s:atend and { var Str l := s:readline ; l<>"" }
607	if (l parse "server-key:" any:(var Str encoded))
608	answer += " server_key "+string:encoded
609	eif (l parse "client-key:" any:(var Str encoded))
610	answer += " client_key "+string:encoded
611	info options := answer 1 answer:len
612	status := shunt answer<>"" success failure
613	else
614	status := failure
615
616
617	gvar SecuredFileSystem secured_file_system
618	pliant_multi_file_system mount "channel:" "" "" secured_file_system
619	pliant_multi_file_system mount "zchannel:" "" "zlib" secured_file_system
620
621
622
623
624
625	type NullStreamDriver
626	void
627	StreamDriver maybe NullStreamDriver
628
629	method drv read buf mini maxi -> red
630	arg_rw NullStreamDriver drv ; arg Address buf ; arg Int mini maxi red
631	memory_clear buf maxi
632	red := maxi
633
634	method drv write buf mini maxi -> written
635	arg_rw NullStreamDriver drv ; arg Address buf ; arg Int mini maxi written
636	written := maxi
637
638
639	type NullFileSystem
640	void
641	FileSystem maybe NullFileSystem
642
643	method fs open name options flags stream support -> status
644	arg_rw NullFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
645	stream stream_driver :> new NullStreamDriver
646	status := success
647
648	gvar NullFileSystem null_file_system
649	pliant_multi_file_system mount "null:" "" null_file_system
650
651
652
653
654
655	method ch channel_support -> s
656	arg_rw Stream ch ; arg_C Stream s
657	s :> ch
658	while { var Pointer:Type t :> entry_type (addressof s:stream_driver) ; t=SecuredStreamDriver or t:name="CompressZlibStreamDriver" }
659	s :> (addressof s:stream_driver) map Link:Stream
660
661	export '. channel_support'