/pliant/appli/file_browser.pli
1	module "/pliant/protocol/http/server.pli"
2	module "/pliant/protocol/http/style/default.style"
3	module "/pliant/protocol/common/mime.pli"
4	module "/pliant/language/context.pli"
5	module "/pliant/language/compiler.pli"
6	module "/pliant/language/stream.pli"
7	module "/pliant/admin/file.pli"
8	module "/pliant/admin/execute.pli"
9	module "/pliant/util/encoding/http.pli"
10	module "/pliant/util/encoding/date.pli"
11	module "/pliant/protocol/http/webdav.pli"
12	if os_api="linux"
13	module "/pliant/language/stream/pipe.pli"
14
15
16	plugin timeout
17	constant tar_timeout 3600 # the downgrade.tgz should be packed in less than xxx seconds
18	constant upgrade_timeout 7200 # the downgrade.tgz should have been remotely removed in less than xxx seconds
19
20
21	module "/pliant/fullpliant/this_computer.pli"
22	constant fullpliant this_computer:env:"pliant":"system":"distribution"="fullpliant"
23	if os_api="linux"
24	module "/pliant/linux/kernel/shutdown.pli"
25	if fullpliant
26	module "/pliant/fullpliant/shutdown.pli"
27
28
29	module "/pliant/storage/database.pli"
30
31	method page apply_uploaded_file src dest fileoptions0 -> status
32	arg_rw HtmlPage page ; arg Str src dest fileoptions0 ; arg Status status
33	var Str ext := dest (dest search "." dest:len) dest:len
34	if ext=".pdb" and (data_file_switch src dest)=success
35	return success
36	if fullpliant and ext=".tgz" and file_os_name:dest=file_os_name:"file:/boot/upgrade.tgz"
37	file_delete "file:/boot/downgrade.tgz"
38	execute "pliant module /pliant/install/minimal.pli module /pliant/fullpliant/recover.pli command 'downgrade "+string:upgrade_timeout+"'" detached
39	var Float remain := tar_timeout
40	while remain>0 and (file_query "file:/boot/downgrade.tgz" standard)=undefined
41	sleep 1
42	if remain>0
43	var Array:FileInfo files := file_list "file:/pliant/binary/" standard
44	for (var Int i) 0 files:size-1
45	if files:i:extension=".dump"
46	file_delete files:i:name
47	file_move src dest
48	file_extract dest "file:/"
49	file_delete dest
50	page shutdown 120 "restart"
51	eif fullpliant and ext=".tgz" and file_os_name:dest=file_os_name:"file:/boot/pliant.tgz"
52	var Array:FileInfo files := file_list "file:/pliant/binary/" standard
53	for (var Int i) 0 files:size-1
54	if files:i:extension=".dump"
55	file_delete files:i:name
56	file_move src dest
57	file_extract dest "file:/"
58	file_delete dest
59	page shutdown 120 "restart"
60	eif fullpliant and os_api="linux" and ext=".tgz" and (file_os_name:dest=file_os_name:"file:/boot/fullpliant.tgz" or file_os_name:dest=file_os_name:"file:/boot/kernel.tgz" or file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz")
61	var Array:FileInfo files := file_list "file:/pliant/binary/" standard
62	for (var Int i) 0 files:size-1
63	if files:i:extension=".dump"
64	file_delete files:i:name
65	file_move src dest
66	page shutdown 120 ""
67	file_move "security:/" "file:/pliant_security.backup/"
68	if file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz"
69	file_move "file:/boot/kernel" "file:/boot/fullpliant"
70	file_extract dest "file:/"
71	if file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz"
72	file_move "file:/boot/kernel" "file:/boot/once"
73	file_move "file:/boot/fullpliant" "file:/boot/kernel"
74	file_tree_delete "security:/"
75	file_move "file:/pliant_security.backup/" "security:/"
76	pliant_load_module "/pliant/appli/file_browser/lilo.pli" the_module:"/pliant/language/basic/safe.pli" 0 (null map Module)
77	if file_os_name:dest=file_os_name:"file:/boot/kernel.tgz" or file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz"
78	file_tree_delete "file:/sbin/"
79	file_tree_delete "file:/etc/"
80	file_tree_delete "file:/usr/"
81	file_tree_delete "file:/var/"
82	file_delete "file:/boot/modules.tgz"
83	if file_os_name:dest=file_os_name:"file:/boot/kernel.tgz"
84	file_move dest "file:/boot/modules.tgz"
85	else
86	file_delete dest
87	else
88	file_delete dest
89	kernel_shutdown true
90	var Str fileoptions := shunt fileoptions0<>"" fileoptions0 (file_query dest extended):options
91	status := file_move src dest
92	if status=failure
93	file_delete dest
94	status := file_move src dest
95	file_configure dest fileoptions
96
97
98	function rec_path_size path count size
99	arg Str path ; arg_rw Int count ; arg_rw Intn size
100	var Array:FileInfo files := file_list path extended+directories
101	for (var Int i) 0 files:size-1
102	if files:i:is_link
103	void
104	eif files:i:is_directory
105	rec_path_size files:i:name count size
106	else
107	count += 1 ; size += files:i size
108
109	function path_size path count size
110	arg Str path ; arg_w Int count ; arg_w Intn size
111	count := 0 ; size := 0
112	rec_path_size path count size
113
114	method page browse_directory path options write direct_path
115	arg_rw HtmlPage page ; arg Str path options ; arg CBool write ; arg Str direct_path
116	implicit page
117	if options="delete" and write
118	[Are you sure that you want to delete directory] ; fixed:(text " "+path) ; eol
119	button "yes" noeol
120	file_tree_delete path
121	goto_backward
122	button "no"
123	goto_backward
124	eif options="list"
125	var Array:FileInfo files := file_list path extended+relative+directories
126	for (var Int i) 0 files:size-1
127	html "<pfile name=[dq]"+(html_encode files:i:name)+"[dq] size=[dq]"+(string files:i:size)+"[dq] date=[dq]"+(string files:i:datetime)+"[dq] options=[dq]"+(html_encode files:i:options)+"[dq] />[lf]"
128	else
129	head "<meta name=[dq]robots[dq] content=[dq]noindex,nofollow[dq]>[lf]"
130	var CBool detailed := (options option "detailed") and allowed:"administrator"
131	title path
132	table columns 2 border 0
133	cell [Path:]
134	cell (fixed text:path)
135	if not detailed and allowed:"administrator"
136	link "compute disk usage" "./" options "detailed"
137	var Array:FileInfo files := file_list path extended+relative+directories+sorted
138	var Int total_count := 0 ; var Intn total_size := 0
139	table columns (shunt detailed 5 4)
140	cell header
141	bold [name]
142	if detailed
143	cell header
144	bold [count]
145	cell header
146	bold [size]
147	cell header
148	bold [date ]
149	note "*"
150	title "Pliant date format"
151	[The date is displayed using] ; fixed [ ] ; italic [year] ; [/] ; italic [month] ; [/] ; italic [day] ; [ ] ; italic [hour] ; [:] ; italic [minute] ; [:] ; italic [second] ; fixed [ ] ; [format.]
152	cell header
153	void
154	for (var Int i) 0 files:size-1
155	var Pointer:FileInfo f :> files i
156	html "<pfile name=[dq]"+(html_encode f:name)+"[dq] size=[dq]"+(string f:size)+"[dq] date=[dq]"+(string f:datetime)+"[dq] options=[dq]"+(html_encode f:options)+"[dq] />[lf]"
157	if f:is_directory
158	cell
159	bold
160	link f:name f:name relative no_extension
161	if detailed
162	path_size path+f:name (var Int count) (var Intn size)
163	cell
164	italic (text string:count)
165	cell
166	if (options option "byte")
167	italic (text string:size)
168	else
169	italic (text (string size\2^20)+" MB")
170	total_count += count ; total_size += size
171	else
172	cell void
173	cell void
174	cell
175	small
176	if (file_list path+f:name standard+directories):size=0 and write
177	link "delete" f:name relative no_extension options "delete"
178	else
179	cell
180	if direct_path<>""
181	link f:name direct_path+f:name relative no_extension
182	eif (query_mime_type f:extension)<>""
183	link f:name f:name relative no_extension
184	else
185	text f:name
186	if detailed
187	cell void
188	cell
189	text (string f:size "separated [dq]"+character:183+"[dq]")
190	cell
191	text (string f:datetime)
192	cell
193	small
194	var Str mime := query_mime_type f:extension
195	if not (mime parse "binary/" any) and not (mime parse "image/" any)
196	link "view" f:name relative no_extension options "text" ; fixed [ ]
197	if write
198	link "edit" f:name relative no_extension options "edit" ; fixed [ ]
199	link "download" f:name relative no_extension options "binary" ; fixed [ ]
200	if write
201	link "copy" f:name relative no_extension options "copy" ; fixed [ ]
202	link "delete" f:name relative no_extension options "delete"
203	total_count += 1 ; total_size += f size
204	if detailed
205	cell header
206	[total]
207	cell
208	italic (text string:total_count)
209	cell
210	if (options option "byte")
211	italic (text string:total_size)
212	else
213	italic (text (string total_size\2^20)+" MB")
214	cell void
215	cell void
216	if write
217	if os_api="linux" and allowed:"administrator"
218	input "" (var Str subdirs) noeol
219	note "*"
220	[Leave the field blank if you want to download the all directory content.]
221	page button ".tgz download"
222	stream_pipe (var Str in_pipe_name) (var Str out_pipe_name)
223	thread
224	execute "tar -zc "+(shunt subdirs<>"" subdirs ".") path path output out_pipe_name
225	(var Stream tgz) open in_pipe_name in+safe
226	reset_http_answer
227	http_request send_header "mime [dq]binary/*[dq]"
228	while not tgz:atend and http_request:answer_stream=success
229	raw_copy tgz http_request:answer_stream 1 2^16
230	http_request send_footer
231	file_upload "" (var Str filename) noeol
232	button "Upload" noeol
233	if (file_query filename standard)=defined
234	var Str remote := filename option "remote_name" Str
235	if remote<>""
236	apply_uploaded_file filename path+remote ""
237	reload_page
238	else
239	[I have not received the file name !]
240	else
241	[I have not received the file !]
242	para
243	[The explaination might be that your browser does not support uploading because it cannot send multipart forms.] ; eol
244	[If you wonder what browsers supports uploading, then all I can tel you is that Nestcape 4 and Mozilla do.]
245	if os_api="linux" and allowed:"administrator"
246	page button ".tgz upload" noeol
247	var Str tgz := replace file_temporary ".tmp" ".tgz"
248	file_move filename tgz
249	file_extract tgz path
250	file_delete tgz
251	reload_page
252	eol
253	input "" (var Str filename2) noeol
254	button "Create file" noeol
255	(var Stream s) open path+filename2 out+safe ; s close
256	reload_page
257	button "Create directory"
258	file_tree_create path+filename2+"/"
259	reload_page
260	# input "Target computer: " (var Str target) noeol
261	# input "Password: " (var Str passwd) password noeol
262	# button "Synchronize"
263	#   void
264	if allowed:"administrator"
265	page button "Delete directory"
266	title "Delete "+path+" directory"
267	para
268	[Here is the list of the files you are going to delete:] ; eol
269	var Array:FileInfo files2 := file_list path standard+recursive+sorted
270	var Intn total := 0
271	for (var Int i) 0 files2:size-1
272	fixed (text files2:i:name) ; eol
273	total += files2:i size
274	text "That's "+(string files2:size)+" files containing "+(string total\2^20)+" MB of datas."
275	para
276	[Are you sure that you want to recursively delete all files in]
277	fixed (text " "+path+" ")
278	[?]
279	para
280	button "yes" noeol
281	file_tree_delete path
282	goto_backward
283	button "no"
284	goto_backward
285	table columns 1
286	cell
287	table columns 2 border 0
288	cell
289	input "Name pattern: " (var Str name_pattern)
290	if allowed:"administrator"
291	input "Content pattern: " (var Str content_pattern) noeol
292	select "Case sensitive: " (var Str case_sensitive)
293	option "no" ""
294	option "yes" "yes"
295	cell
296	button "Search"
297	title "Files search report"
298	table columns 2 border 0
299	cell [Path:]
300	cell (fixed text:path)
301	if name_pattern<>""
302	cell [Name pattern:]
303	cell (fixed text:name_pattern)
304	if content_pattern<>""
305	cell [Content pattern:]
306	cell (fixed text:content_pattern)
307	var Array:FileInfo all_files := file_list path standard+relative+directories+recursive+sorted
308	var CBool case := case_sensitive="yes"
309	if content_pattern<>"" and allowed:"administrator"
310	table columns 2
311	for (var Int i) 0 all_files:size-1
312	if name_pattern="" or (all_files:i:name_without_path search name_pattern -1)<>(-1)
313	(var Stream s) open path+all_files:i:name in+safe
314	while not s:atend
315	var Str l := s readline
316	var CBool matching
317	if case
318	matching := (l search content_pattern -1)<>(-1)
319	else
320	matching := (upper:l search upper:content_pattern -1)<>(-1)
321	if matching
322	cell
323	link all_files:i:name all_files:i:path relative no_extension
324	cell
325	small
326	fixed text:l ; eol
327	while not s:atend
328	var Str l := s readline
329	if case
330	matching := (l search content_pattern -1)<>(-1)
331	else
332	matching := (upper:l search upper:content_pattern -1)<>(-1)
333	if matching
334	fixed text:l ; eol
335	else
336	for (var Int i) 0 all_files:size-1
337	if name_pattern="" or (all_files:i:name_without_path search name_pattern -1)<>(-1)
338	link all_files:i:name all_files:i:path relative no_extension ; eol
339
340
341	method page browse_file path options write
342	arg_rw HtmlPage page ; arg Str path options ; arg CBool write
343	implicit page
344	if options="text"
345	reset_http_answer
346	http_request send_static_file path "mime [dq]text/plain[dq]"
347	eif options="binary"
348	reset_http_answer
349	http_request send_static_file path "mime [dq]binary/*[dq]"
350	eif options="edit" and write
351	small
352	bold text:path
353	var FileInfo info := file_query path extended
354	if info:link<>""
355	text " -> "+info:link
356	html (repeat 5 "&nbsp;")
357	text (string info:size)+" bytes last modifyed on "+(string info:datetime)
358	eol
359	var Str all := ""
360	(var Stream s1) open path in+safe
361	while not s1:atend
362	all += s1:readline+"[lf]"
363	text_input "" all columns 80 rows 35
364	button "Update "+(path (path search_last "/" -1)+1 path:len)
365	(var Stream s2) open path out+safe
366	s2 writechars all
367	goto_backward
368	eif options="copy" and write
369	[Move ] ; fixed:(text " "+path+" ")
370	input " to: " (var Str to)
371	button "Copy" noeol
372	var Str dest := to
373	if (dest 0 1)<>"/" and (dest search ":" -1)=(-1)
374	dest := (path 0 (path search_last "/" -1)+1)+dest
375	else
376	requires "administrator"
377	if (reverse:dest 0 1)="/"
378	dest += path (path search_last "/" path:len)+1 path:len
379	file_copy path dest
380	goto_backward
381	button "Move" noeol
382	var Str dest := to
383	if (dest 0 1)<>"/" and (dest search ":" -1)=(-1)
384	dest := (path 0 (path search_last "/" -1)+1)+dest
385	else
386	requires "administrator"
387	if (reverse:dest 0 1)="/"
388	dest += path (path search_last "/" path:len)+1 path:len
389	file_move path dest
390	goto_backward
391	button "Cancel"
392	goto_backward
393	eif options="delete" and write
394	[Are you sure that you want to delete file] ; fixed:(text " "+path) ; eol
395	button "yes" noeol
396	file_delete path
397	goto_backward
398	button "no"
399	goto_backward
400	else
401	reset_http_answer
402	http_request send_static_file path ""
403
404
405	method page file_browser path options write direct_path
406	arg_rw HtmlPage page ; arg Str path options ; arg CBool write ; arg Str direct_path
407	implicit page
408	var Str answer := ""
409	if virtual_command="GET" or virtual_command="POST"
410	if path:len>0 and (path path:len-1)="/"
411	browse_directory path options write direct_path
412	else
413	browse_file path options write
414	eif virtual_command="HEAD"
415	var FileInfo info := file_query path extended
416	if info=success
417	reset_http_answer
418	if not info:is_directory
419	http_request answer_size := info size
420	http_request answer_datetime := info datetime
421	http_request answer_is_dynamic := false
422	http_request send_header
423	http_request send_footer
424	else
425	answer := "404 Not found"
426	eif virtual_command="PUT"
427	if not write
428	reset_http_answer
429	http_request send_authentification_request
430	return
431	var DateTime dt := undefined
432	var Str opt := ""
433	var Pointer:Arrow c :> http_request:query_log first
434	while c<>null
435	var Pointer:Str s :> c map Str
436	if (s parse acword:"pliant-options" ":" any:(var Str value))
437	opt := http_decode value
438	eif (s parse acword:"last-modified" ":" any:(var Str value))
439	dt := rfc1123_date value
440	c :> http_request:query_log next c
441	var Str temp := file_temporary
442	reset_http_answer
443	(var Stream data) open temp out+safe
444	var Int bytes := 0
445	while not http_request:query_stream:atend and data=success
446	bytes += raw_copy http_request:query_stream data 1 2^24
447	data close
448	if dt=defined
449	file_configure temp "datetime "+string:dt
450	answer := shunt (apply_uploaded_file temp path opt)=success "200 OK" "500 Could not write file"
451	file_delete temp
452	eif virtual_command="OPTIONS"
453	answer := "200 OK"
454	http_request:answer_extra append addressof:(new Str "Allow: OPTIONS, PROPFIND, MKCOL")
455	http_request:answer_extra append addressof:(new Str "DAV: 1,2")
456	eif virtual_command="PROPFIND"
457	var FileInfo info := file_query path extended
458	var Array:FileInfo dir
459	if http_request:webdav_depth<>0
460	dir := file_list info:name extended+directories+relative+sorted
461	webdav_propfind info dir
462	eif virtual_command="PROPPATCH" or virtual_command="LOCK" or virtual_command="UNLOCK"
463	answer := "200 OK"
464	eif virtual_command="MKCOL"
465	if not write
466	reset_http_answer
467	http_request send_authentification_request
468	return
469	var Str slash := shunt path:len=0 or (path path:len-1)<>"/" "/" ""
470	answer := shunt (file_tree_create path+slash)=success "201 Created" "500 Could not create directory"
471	eif virtual_command="MOVE"
472	answer := "403 Forbidden"
473	var Str src := "http://"+http_request:site_name+http_request:encoded_path
474	var Str dest := ""
475	var Pointer:Arrow c :> http_request:query_log first
476	while c<>null
477	if ((c map Str) parse acword:"Destination" ":" any:(var Str value))
478	dest := value
479	c :> http_request:query_log next c
480	if (dest eparse "http://" any:(var Str dest_site) ":" (var Int dest_port) "/" any:(var Str dest_path)) and (dest_site search "/" -1)=(-1)
481	dest := "http://"+dest_site+"/"+dest_path
482	if (dest 0 (dest search_last "/" dest:len)+1)=(src 0 (src search_last "/" src:len)+1)
483	var Status status := file_move path (path 0 (path search_last "/" path:len)+1)+http_decode:(dest (dest search_last "/" dest:len)+1 dest:len)
484	if status=success
485	answer := "201 Created"
486	eif virtual_command="DELETE"
487	if not write
488	reset_http_answer
489	http_request send_authentification_request
490	return
491	answer := shunt file_delete:path=success or (file_tree_delete path+"/")=success "200 OK" "404 No such file"
492	else
493	answer := "501 Not implemented"
494	if answer<>""
495	reset_http_answer
496	http_request send_header "status "+string:answer+" size 0 static"
497	http_request send_footer
498
499	export '. apply_uploaded_file' '. file_browser'