/pliant/linux/storage/filesystem.pli
1	abstract
2	[This module will give you the ability to deal with Linux disk related features (mounting, umounting and querying a partition).]
3
4
5	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
6	#
7	# This program is free software; you can redistribute it and/or
8	# modify it under the terms of the GNU General Public License version 2
9	# as published by the Free Software Foundation.
10	#
11	# This program is distributed in the hope that it will be useful,
12	# but WITHOUT ANY WARRANTY; without even the implied warranty of
13	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14	# GNU General Public License for more details.
15	#
16	# You should have received a copy of the GNU General Public License
17	# version 2 along with this program; if not, write to the Free Software
18	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20	module "/pliant/language/os.pli"
21	module "/pliant/language/stream.pli"
22	module "/pliant/admin/file.pli"
23	module "/pliant/admin/execute.pli"
24	module "/pliant/linux/kernel/device.pli"
25
26	if os_api<>"linux"
27	error error_id_missing "This module works only with Linux"
28
29	constant trace false
30
31
32
33
34
35	function os_mount dev dir fs flags opt -> err
36	arg CStr dev dir fs ; arg Int flags ; arg CStr opt ; arg Int err
37	kernel_function 21
38
39	function os_umount name flags -> err
40	arg CStr name ; arg Int flags err
41	kernel_function 52
42
43
44	type os_statfs
45	field uInt type
46	field uInt bsize
47	field uInt blocks
48	field uInt bfree
49	field uInt bavail
50	field uInt bfiles
51	field uInt ffree
52	field (Array uInt 2) fsid
53	field uInt namelen
54	field (Array uInt 6) spare
55
56	function os_statfs path buf -> err
57	arg CStr path ; arg_w os_statfs buf ; arg Int err
58	kernel_function 99
59
60
61
62
63
64	doc
65	['filesystem_name' works only for EXT2 partitions, and will return the volume name of the partition]
66	[ (you can also get it using 'tune2fs -l' Unix command).]
67
68
69	function filesystem_study device fs label
70	arg Str device ; arg_w Str fs label
71	fs := "" ; label := ""
72	var Stream dev ; dev open device in+safe
73	if dev=failure
74	return
75	part ext2
76	dev configure "seek "+string:438h
77	var uInt16 sign2 ; dev raw_read addressof:sign2 uInt16:size
78	if sign2=0EF53h
79	dev configure "seek "+(string 1024+224)
80	dev raw_read addressof:(var uInt32 journal) uInt32:size
81	fs := shunt journal=0 "ext2" "ext3"
82	dev configure "seek "+string:478h
83	for (var Int i) 1 16
84	var Char c ; dev raw_read addressof:c Char:size
85	if c:number=0
86	return
87	else
88	label += c
89	return
90	part xfs
91	dev configure "seek 0"
92	var uInt32_hi sign4 ; dev raw_read addressof:sign4 uInt32_hi:size
93	if sign4=58465342h
94	fs := "xfs"
95	dev configure "seek 108"
96	for (var Int i) 1 12
97	var Char c ; dev raw_read addressof:c Char:size
98	if c:number=0
99	return
100	else
101	label += c
102	return
103	part iso9660
104	dev configure "seek "+(string 16*2048)
105	var Str sign := repeat 8 " " ; dev raw_read sign:characters sign:len
106	if sign=character:1+"CD001"+character:1+"[0]" # ISO9660
107	fs := "iso9660"
108	label := repeat 32 " "
109	dev raw_read label:characters label:len
110	dev raw_read label:characters label:len
111	while label:len>0 and (label label:len-1)=" "
112	label := label 0 label:len-1
113	label := label 0 (label search "[0]" label:len)
114	return
115
116	function filesystem_filesystem device -> fs
117	arg Str device fs
118	filesystem_study device fs (var Str label)
119
120	function filesystem_name device -> label
121	arg Str device label
122	filesystem_study device (var Str fs) label
123
124	function filesystem_bus device -> bus
125	arg Str device bus
126	bus := ""
127	if (file_os_name:device eparse "/dev/" any:(var Str dev))
128	var FileInfo info := file_query "file:/sys/block/"+dev+"/device" extended
129	var Str link := info:options option "link" Str
130	if (link eparse "../../devices/" any:(var Str remain))
131	link := remain
132	while (link eparse any:(var Str first) "/" any:(var Str remain)) and (first search ":" -1)<>(-1)
133	link := remain
134	if (link eparse any:(var Str first) "/" any)
135	if (first eparse any:(var Str s) (var Int i))
136	bus := s
137
138	doc
139	['filesystem_scan' will call 'filesystem_name' on all standard Linux disks and partitions in order to build a mapping volume_name -> device so that you can later use 'filesystem_mount' function specifying the volume name instead of the device.]
140
141	gvar Dictionary partitions
142
143	function filesystem_scan
144	partitions := var Dictionary empty
145	for (var Int i) 0 1
146	for (var Int p) 0 4
147	for (var Int d) 0 25
148	var Str device := "device:/"+(shunt i=0 "h" "s")+"d"+(character "a":0:number+d)+(shunt p<>0 string:p "")
149	if trace
150	console "scanning "+device+"[cr]"
151	var Str name := filesystem_name device
152	if name<>""
153	partitions insert name true addressof:(new Str device)
154	if trace
155	console "found partition "+name+" on "+device+"[lf]"
156	if trace
157	console (repeat 40 " ")+"[lf]"
158
159
160
161
162
163	doc
164	['filesystem_query' will will return the total size and still available space on a mounted partition which MUST be specifyed by it's mount point.]
165
166	public
167	type DiskInfo
168	field Intn size
169	field Intn available
170
171	function filesystem_query path -> info
172	arg Str path ; arg DiskInfo info
173	info size := undefined
174	info available := undefined
175	if (path parse "device:/" any:(var Str name))
176	(var Stream s) open "file:/proc/partitions" in+safe
177	while not s:atend
178	if (s:readline parse (var Int major) (var Int minor) (var uInt blocs) pattern:name)
179	info size := blocs*1024n
180	else
181	if (os_statfs file_os_name:path (var os_statfs buf))=0
182	info size := buf:blocks*(cast buf:bsize Intn)
183	info available := buf:bavail*(cast buf:bsize Intn)
184
185
186	function filesystem_is_mounted spec -> mounted
187	arg Str spec ; arg CBool mounted
188	var Str os_spec := file_os_name spec
189	(var Stream m) open "file:/proc/mounts" in+safe
190	while not m:atend
191	if (m:readline eparse any:(var Str dev) _ any:(var Str path) _ any)
192	if os_spec=dev or os_spec=path or os_spec=path+"/"
193	return true
194	mounted := false
195
196
197	function filesystem_dev_mount dev path fs options -> status
198	arg Str dev path fs options ; arg Status status
199	var Str extra := options option "linux_options" Str
200	var Int err := os_mount file_os_name:dev file_os_name:path fs 0C0ED0000h+(shunt (options option "readonly") 1 0)+(shunt (options option "remount") 32 0)+(shunt (options option "read_datetime") 0 1024+2048) extra
201	if true # trace
202	console "mounting " file_os_name:dev " at " file_os_name:path " with filesystem " fs " and options " extra " -> " err eol
203	status := shunt err=0 success failure
204
205	function filesystem_dev_dismount name options -> status
206	arg Str name options ; arg Status status
207	var Int err := os_umount file_os_name:name (shunt (options option "force") 1 0)+(shunt (options option "lazy") 2 0)
208	status := shunt err=0 success failure
209
210
211	doc
212	['filesystem_mount' will mount a partition either provided by it's volume name ('disk_scan' must have been called once previously) or by it's device name.] ; eol
213	[The possible options are:]
214	list
215	item
216	fixed [filesystem [dq]] ; italic [name]; fixed [[dq]] ; [ defines the kind of filesystem to be mounted (default is [dq]ext2[dq])]
217	item
218	fixed [check ] ; [ will force to e2fsck the partition]
219	item
220	fixed [nocheck ] ; [ will not e2fsck the partition]
221	item
222	fixed [tune ] ; [ will set the options I like for a data storage partition (remount read only in case of failure and only 1MB reserved for root)]
223	item
224	fixed [readonly ] ; [ mounts the partition read only]
225	[If none of 'check' and 'nocheck' is specifyed, check if required is applyed (not properly umounted, or mounted many times since last check, or not checked for many many days partition).]
226
227	function filesystem_mount name path options -> status
228	arg Str name path options ; arg Status status
229	var Str device
230	if file_os_name:name<>""
231	device := name
232	eif { var Pointer:Arrow a :> partitions first name ; a<>null }
233	device := a map Str
234	else
235	return failure
236	if (file_query device standard)=undefined
237	kernel_make_device device
238	var Str fs := options option "filesystem" Str
239	if fs=""
240	fs := filesystem_filesystem device
241	if not (options option "nocheck") and (fs="ext2" or fs="ext3") and not filesystem_is_mounted:path
242	var Int err := execute "e2fsck -y"+(shunt (options option "check") " -f" "")+(shunt (options option "surface") " -c" "")+" "+file_os_name:device quiet
243	if err<>0
244	console "Failed to check " device " partition (error code is " err ") ... retrying in verbose mode." eol
245	err := execute "e2fsck -y"+(shunt (options option "check") " -f" "")+" "+file_os_name:device mixed
246	if err<>0
247	console "Failed to check " device " partition !  (error code is " err ")" eol
248	if (options option "check") and fs="xfs" and not filesystem_is_mounted:path
249	var Int err := execute "xfs_repair "+file_os_name:device mixed
250	if err<>0
251	console "Failed to repair " device " partition !  (error code is " err ")" eol
252	if (options option "tune")
253	execute "tune2fs -e remount-ro -r 1024 "+device quiet
254	file_tree_create path
255	status := filesystem_dev_mount device path fs options
256
257
258	doc
259	['filesystem_dismount' will umount a partition either specifyed by it's volume name, it's device name or it's mount path.]
260
261	function filesystem_dismount name options -> status
262	arg Str name options ; arg Status status
263	var Str device
264	if file_os_name:name<>""
265	device := name
266	eif { var Pointer:Arrow a :> partitions first name ; a<>null }
267	device := a map Str
268	else
269	return failure
270	status := filesystem_dev_dismount device options
271
272	function filesystem_dismount name -> status
273	arg Str name ; arg Status status
274	status := filesystem_dismount name ""
275
276
277
278
279
280	export filesystem_filesystem filesystem_name filesystem_bus
281	export filesystem_scan filesystem_mount filesystem_dismount filesystem_query filesystem_is_mounted