/[mldonkey]/mldonkey/src/config/unix/mlUnix.ml
ViewVC logotype

Diff of /mldonkey/src/config/unix/mlUnix.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by spiralvoice, Sat May 28 10:20:33 2005 UTC revision 1.8 by spiralvoice, Tue Jul 26 21:35:10 2005 UTC
# Line 89  let chroot = Unix.chroot Line 89  let chroot = Unix.chroot
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

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26