89 |
let write = Unix.write |
let write = Unix.write |
90 |
|
|
91 |
let set_nonblock = Unix.set_nonblock |
let set_nonblock = Unix.set_nonblock |
92 |
|
|
93 |
|
type statfs = { |
94 |
|
f_type : int64; (* type of filesystem *) |
95 |
|
f_bsize : int64; (* optimal transfer block size *) |
96 |
|
f_blocks : int64; (* total data blocks in file system *) |
97 |
|
f_bfree : int64; (* free blocks in fs *) |
98 |
|
f_bavail : int64; (* free blocks avail to non-superuser *) |
99 |
|
f_files : int64; (* total file nodes in file system *) |
100 |
|
f_ffree : int64; (* free file nodes in fs *) |
101 |
|
f_fsid : unit; (* See note in statfs(2) *) |
102 |
|
f_fnamelen : int64; (* maximum length of filenames *) |
103 |
|
f_basetype : string; (* type of filesystem - Solaris, (-1) on other systems, use f_type there *) |
104 |
|
f_frsize : int64; (* Fundamental file system block size, (-1) if not provided by system *) |
105 |
|
} |
106 |
|
|
107 |
|
exception Not_supported |
108 |
|
exception Error |
109 |
|
|
110 |
|
let _ = Callback.register_exception "not supported" Not_supported |
111 |
|
let _ = Callback.register_exception "error" Error |
112 |
|
|
113 |
|
external statfs : string -> statfs = "statfs_statfs" |
114 |
|
external fstatfs : Unix.file_descr -> statfs = "statfs_fstatfs" |
115 |
|
|
116 |
|
let ( ** ) x y = Int64.mul x y |
117 |
|
let ( ++ ) x y = Int64.add x y |
118 |
|
let ( -- ) x y = Int64.sub x y |
119 |
|
let ( // ) x y = Int64.div x y |
120 |
|
|
121 |
|
let bsize dir = |
122 |
|
begin |
123 |
|
try |
124 |
|
let s = statfs dir in |
125 |
|
if s.f_frsize = Int64.zero || s.f_frsize = Int64.of_int (-1) then |
126 |
|
s.f_bsize |
127 |
|
else |
128 |
|
s.f_frsize |
129 |
|
with e -> Int64.of_int (-1) |
130 |
|
end |
131 |
|
|
132 |
|
let blocks dir = |
133 |
|
begin |
134 |
|
try |
135 |
|
let s = statfs dir in |
136 |
|
s.f_blocks |
137 |
|
with e -> Int64.of_int (-1) |
138 |
|
end |
139 |
|
|
140 |
|
let bfree dir = |
141 |
|
begin |
142 |
|
try |
143 |
|
let s = statfs dir in |
144 |
|
s.f_bfree |
145 |
|
with e -> Int64.of_int (-1) |
146 |
|
end |
147 |
|
|
148 |
|
let bavail dir = |
149 |
|
begin |
150 |
|
try |
151 |
|
let s = statfs dir in |
152 |
|
s.f_bavail |
153 |
|
with e -> Int64.of_int (-1) |
154 |
|
end |
155 |
|
|
156 |
|
let fnamelen dir = |
157 |
|
begin |
158 |
|
try |
159 |
|
let s = statfs dir in |
160 |
|
s.f_fnamelen |
161 |
|
with e -> Int64.of_int (-1) |
162 |
|
end |
163 |
|
|
164 |
|
let disktotal dir = |
165 |
|
(* total disk space in bytes *) |
166 |
|
begin |
167 |
|
try |
168 |
|
let s = statfs dir in |
169 |
|
((bsize dir) ** s.f_blocks) |
170 |
|
with e -> Int64.of_int (-1) |
171 |
|
end |
172 |
|
|
173 |
|
let diskfree dir = |
174 |
|
(* free disk space in bytes *) |
175 |
|
begin |
176 |
|
try |
177 |
|
let s = statfs dir in |
178 |
|
((bsize dir) ** s.f_bavail) |
179 |
|
with e -> Int64.of_int (-1) |
180 |
|
end |
181 |
|
|
182 |
|
let diskused dir = |
183 |
|
(* used disk space in bytes *) |
184 |
|
begin |
185 |
|
try |
186 |
|
let s = statfs dir in |
187 |
|
((bsize dir) ** (s.f_blocks -- s.f_bavail)) |
188 |
|
with e -> Int64.of_int (-1) |
189 |
|
end |
190 |
|
|
191 |
|
let percentused dir = |
192 |
|
(* percentage of used disk space *) |
193 |
|
if (diskfree dir) = Int64.of_int (-1) then |
194 |
|
(-1) |
195 |
|
else |
196 |
|
Int64.to_int (100L -- ((diskfree dir) ** 100L // (disktotal dir))) |
197 |
|
|
198 |
|
let percentfree dir = |
199 |
|
(* percentage of free disk space *) |
200 |
|
if (diskfree dir) = Int64.of_int (-1) then |
201 |
|
(-1) |
202 |
|
else |
203 |
|
Int64.to_int ((diskfree dir) ** 100L // (disktotal dir)) |
204 |
|
|
205 |
|
let filesystem dir = |
206 |
|
begin |
207 |
|
try |
208 |
|
let s = statfs dir in |
209 |
|
match s.f_type with |
210 |
|
(* values copied from statfs(2) manpage *) |
211 |
|
| 0xadf5L -> "ADFS_SUPER_MAGIC" |
212 |
|
| 0xADFFL -> "AFFS_SUPER_MAGIC" |
213 |
|
| 0x42465331L -> "BEFS_SUPER_MAGIC" |
214 |
|
| 0x1BADFACEL -> "BFS_MAGIC" |
215 |
|
| 0xFF534D42L -> "CIFS_MAGIC_NUMBER" |
216 |
|
| 0x73757245L -> "CODA_SUPER_MAGIC" |
217 |
|
| 0x012FF7B7L -> "COH_SUPER_MAGIC" |
218 |
|
| 0x28cd3d45L -> "CRAMFS_MAGIC" |
219 |
|
| 0x1373L -> "DEVFS_SUPER_MAGIC" |
220 |
|
| 0x00414A53L -> "EFS_SUPER_MAGIC" |
221 |
|
| 0x137DL -> "EXT_SUPER_MAGIC" |
222 |
|
| 0xEF51L -> "ext2" (* EXT2_OLD_SUPER_MAGIC *) |
223 |
|
| 0xEF53L -> "ext2/3" (* EXT2/3_SUPER_MAGIC *) |
224 |
|
| 0x4244L -> "HFS_SUPER_MAGIC" |
225 |
|
| 0xF995E849L -> "HPFS_SUPER_MAGIC" |
226 |
|
| 0x958458f6L -> "HUGETLBFS_MAGIC" |
227 |
|
| 0x9660L -> "ISOFS_SUPER_MAGIC" |
228 |
|
| 0x4000L -> "ISOFS_SUPER_MAGIC_WIN" (* from coreutils-5.2.1, stat.c *) |
229 |
|
| 0x4004L -> "ISOFS_SUPER_MAGIC_R_WIN" (* from coreutils-5.2.1, stat.c *) |
230 |
|
| 0x72b6L -> "JFFS2_SUPER_MAGIC" |
231 |
|
| 0x3153464aL -> "JFS_SUPER_MAGIC" |
232 |
|
| 0x137FL -> "MINIX_SUPER_MAGIC" |
233 |
|
| 0x138FL -> "MINIX_SUPER_MAGIC2" |
234 |
|
| 0x2468L -> "MINIX2_SUPER_MAGIC" |
235 |
|
| 0x2478L -> "MINIX2_SUPER_MAGIC2" |
236 |
|
| 0x4d44L -> "msdos" (* MSDOS_SUPER_MAGIC *) |
237 |
|
| 0x4006L -> "fat" (* from coreutils-5.2.1, stat.c *) |
238 |
|
| 0x564cL -> "NCP_SUPER_MAGIC" |
239 |
|
| 0x6969L -> "NFS_SUPER_MAGIC" |
240 |
|
| 0x5346544eL -> "ntfs" (* NTFS_SB_MAGIC *) |
241 |
|
| 0x9fa1L -> "OPENPROM_SUPER_MAGIC" |
242 |
|
| 0x9fa0L -> "PROC_SUPER_MAGIC" |
243 |
|
| 0x002fL -> "QNX4_SUPER_MAGIC" |
244 |
|
| 0x52654973L -> "reiserfs" (* REISERFS_SUPER_MAGIC *) |
245 |
|
| 0x52345362L -> "reiser4" |
246 |
|
| 0x7275L -> "ROMFS_MAGIC" |
247 |
|
| 0x517BL -> "smb" (* SMB_SUPER_MAGIC *) |
248 |
|
| 0x012FF7B6L -> "SYSV2_SUPER_MAGIC" |
249 |
|
| 0x012FF7B5L -> "SYSV4_SUPER_MAGIC" |
250 |
|
| 0x01021994L -> "tmpfs" (* TMPFS_MAGIC *) |
251 |
|
| 0x15013346L -> "UDF_SUPER_MAGIC" |
252 |
|
| 0x00011954L -> "UFS_MAGIC" |
253 |
|
| 0x9fa2L -> "USBDEVICE_SUPER_MAGIC" |
254 |
|
| 0xa501FCF5L -> "VXFS_SUPER_MAGIC" |
255 |
|
| 0x012FF7B4L -> "XENIX_SUPER_MAGIC" |
256 |
|
| 0x58465342L -> "XFS_SUPER_MAGIC" |
257 |
|
| 0x012FD16DL -> "_XIAFS_SUPER_MAGIC" |
258 |
|
| 5L -> "iso9660" (* Cygwin *) |
259 |
|
| 6L -> "fat" (* Cygwin *) |
260 |
|
| 0x700FFL -> "ntfs" (* Cygwin *) |
261 |
|
| 0xC3L -> "ext2/3" (* Cygwin *) |
262 |
|
| _ -> if s.f_basetype <> "-1" then |
263 |
|
s.f_basetype |
264 |
|
else |
265 |
|
Printf.sprintf "unknown (%Ld)" s.f_type |
266 |
|
with e -> "not supported" |
267 |
|
end |