913 |
|
|
914 |
#endif |
#endif |
915 |
|
|
916 |
|
#include <caml/custom.h> |
917 |
|
#include <caml/callback.h> |
918 |
|
|
919 |
|
#if defined(__MINGW32__) |
920 |
|
/* taken from www.greatchief.plus.com/gpc/os-hacks.h */ |
921 |
|
#define _fullpath(res,path,size) \ |
922 |
|
(GetFullPathName ((path), (size), (res), NULL) ? (res) : NULL) |
923 |
|
|
924 |
|
#define realpath(path,resolved_path) _fullpath(resolved_path, path, MAX_PATH) |
925 |
|
|
926 |
|
#define FAKED_BLOCK_SIZE 512 /* fake block size */ |
927 |
|
|
928 |
|
/* linux-compatible values for fs type */ |
929 |
|
#define MSDOS_SUPER_MAGIC 0x4d44 |
930 |
|
#define NTFS_SUPER_MAGIC 0x5346544E |
931 |
|
|
932 |
|
struct statfs { |
933 |
|
long f_type; /* type of filesystem (see below) */ |
934 |
|
long f_bsize; /* optimal transfer block size */ |
935 |
|
long f_blocks; /* total data blocks in file system */ |
936 |
|
long f_bfree; /* free blocks in fs */ |
937 |
|
long f_bavail; /* free blocks avail to non-superuser */ |
938 |
|
long f_files; /* total file nodes in file system */ |
939 |
|
long f_ffree; /* free file nodes in fs */ |
940 |
|
long f_fsid; /* file system id */ |
941 |
|
long f_namelen; /* maximum length of filenames */ |
942 |
|
long f_spare[6]; /* spare for later */ |
943 |
|
}; |
944 |
|
|
945 |
|
static int statfs (const char *path, struct statfs *buf) |
946 |
|
{ |
947 |
|
HINSTANCE h; |
948 |
|
FARPROC f; |
949 |
|
int retval = 0; |
950 |
|
char tmp [MAX_PATH], resolved_path [MAX_PATH]; |
951 |
|
realpath(path, resolved_path); |
952 |
|
if (!resolved_path) |
953 |
|
retval = - 1; |
954 |
|
else |
955 |
|
{ |
956 |
|
/* check whether GetDiskFreeSpaceExA is supported */ |
957 |
|
h = LoadLibraryA ("kernel32.dll"); |
958 |
|
if (h) |
959 |
|
f = GetProcAddress (h, "GetDiskFreeSpaceExA"); |
960 |
|
else |
961 |
|
f = NULL; |
962 |
|
if (f) |
963 |
|
{ |
964 |
|
ULARGE_INTEGER bytes_free, bytes_total, bytes_free2; |
965 |
|
if (!f (resolved_path, &bytes_free2, &bytes_total, &bytes_free)) |
966 |
|
{ |
967 |
|
errno = ENOENT; |
968 |
|
retval = - 1; |
969 |
|
} |
970 |
|
else |
971 |
|
{ |
972 |
|
buf -> f_bsize = FAKED_BLOCK_SIZE; |
973 |
|
buf -> f_bfree = (bytes_free.QuadPart) / FAKED_BLOCK_SIZE; |
974 |
|
buf -> f_files = buf -> f_blocks = (bytes_total.QuadPart) / FAKED_BLOCK_SIZE; |
975 |
|
buf -> f_ffree = buf -> f_bavail = (bytes_free2.QuadPart) / FAKED_BLOCK_SIZE; |
976 |
|
} |
977 |
|
} |
978 |
|
else |
979 |
|
{ |
980 |
|
DWORD sectors_per_cluster, bytes_per_sector; |
981 |
|
if (h) FreeLibrary (h); |
982 |
|
if (!GetDiskFreeSpaceA (resolved_path, §ors_per_cluster, |
983 |
|
&bytes_per_sector, &buf -> f_bavail, &buf -> f_blocks)) |
984 |
|
{ |
985 |
|
errno = ENOENT; |
986 |
|
retval = - 1; |
987 |
|
} |
988 |
|
else |
989 |
|
{ |
990 |
|
buf -> f_bsize = sectors_per_cluster * bytes_per_sector; |
991 |
|
buf -> f_files = buf -> f_blocks; |
992 |
|
buf -> f_ffree = buf -> f_bavail; |
993 |
|
buf -> f_bfree = buf -> f_bavail; |
994 |
|
} |
995 |
|
} |
996 |
|
if (h) FreeLibrary (h); |
997 |
|
} |
998 |
|
|
999 |
|
/* get the FS volume information */ |
1000 |
|
if (strspn (":", resolved_path) > 0) resolved_path [3] = '\0'; /* we want only the root */ |
1001 |
|
if (GetVolumeInformation (resolved_path, NULL, 0, &buf -> f_fsid, &buf -> f_namelen, NULL, tmp, MAX_PATH)) |
1002 |
|
/* http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/getvolumeinformation.asp */ |
1003 |
|
{ |
1004 |
|
if (strcasecmp ("NTFS", tmp) == 0) |
1005 |
|
{ |
1006 |
|
buf -> f_type = NTFS_SUPER_MAGIC; |
1007 |
|
} |
1008 |
|
else |
1009 |
|
{ |
1010 |
|
buf -> f_type = MSDOS_SUPER_MAGIC; |
1011 |
|
} |
1012 |
|
} |
1013 |
|
else |
1014 |
|
{ |
1015 |
|
errno = ENOENT; |
1016 |
|
retval = - 1; |
1017 |
|
} |
1018 |
|
return retval; |
1019 |
|
} |
1020 |
|
|
1021 |
|
static value |
1022 |
|
copy_statfs (struct statfs *buf) |
1023 |
|
{ |
1024 |
|
CAMLparam0 (); |
1025 |
|
CAMLlocal2 (bufv, v); |
1026 |
|
bufv = caml_alloc (11, 0); |
1027 |
|
v = copy_int64 (buf->f_type); caml_modify (&Field (bufv, 0), v); |
1028 |
|
v = copy_int64 (buf->f_bsize); caml_modify (&Field (bufv, 1), v); |
1029 |
|
v = copy_int64 (buf->f_blocks); caml_modify (&Field (bufv, 2), v); |
1030 |
|
v = copy_int64 (buf->f_bfree); caml_modify (&Field (bufv, 3), v); |
1031 |
|
v = copy_int64 (buf->f_bavail); caml_modify (&Field (bufv, 4), v); |
1032 |
|
v = copy_int64 (buf->f_files); caml_modify (&Field (bufv, 5), v); |
1033 |
|
v = copy_int64 (buf->f_ffree); caml_modify (&Field (bufv, 6), v); |
1034 |
|
v = copy_int64 (buf->f_namelen); caml_modify (&Field (bufv, 8), v); |
1035 |
|
v = copy_string ("-1"); caml_modify (&Field (bufv, 9), v); |
1036 |
|
v = copy_int64 (-1); caml_modify (&Field (bufv, 10), v); |
1037 |
|
CAMLreturn (bufv); |
1038 |
|
} |
1039 |
|
|
1040 |
|
CAMLprim value |
1041 |
|
statfs_statfs (value pathv) |
1042 |
|
{ |
1043 |
|
CAMLparam1 (pathv); |
1044 |
|
CAMLlocal1 (bufv); |
1045 |
|
const char *path = String_val (pathv); |
1046 |
|
struct statfs buf; |
1047 |
|
if (statfs (path, &buf) == -1) |
1048 |
|
raise_constant(*(value *)caml_named_value("error")); |
1049 |
|
bufv = copy_statfs (&buf); |
1050 |
|
CAMLreturn (bufv); |
1051 |
|
} |
1052 |
|
|
1053 |
|
#else /* defined(__MINGW32__) */ |
1054 |
|
|
1055 |
|
#if (defined HAVE_SYS_PARAM_H && HAVE_SYS_MOUNT_H) |
1056 |
|
# include <sys/param.h> |
1057 |
|
# include <sys/mount.h> |
1058 |
|
# define HAVE_STATS 1 |
1059 |
|
#endif |
1060 |
|
#ifdef HAVE_SYS_VFS_H |
1061 |
|
# include <sys/vfs.h> |
1062 |
|
# define HAVE_STATS 1 |
1063 |
|
#endif |
1064 |
|
|
1065 |
|
#ifdef HAVE_STATS |
1066 |
|
static value |
1067 |
|
#if ((defined (sun) || defined (__sun__))) |
1068 |
|
copy_statfs (struct statvfs *buf) |
1069 |
|
#else |
1070 |
|
copy_statfs (struct statfs *buf) |
1071 |
|
#endif |
1072 |
|
{ |
1073 |
|
CAMLparam0 (); |
1074 |
|
CAMLlocal2 (bufv, v); |
1075 |
|
bufv = caml_alloc (11, 0); |
1076 |
|
#if ((defined (sun) || defined (__sun__))) || (defined(__FreeBSD__) && __FreeBSD_version >= 503001) || defined(__OpenBSD__) || defined(__NetBSD__) |
1077 |
|
v = copy_int64 (-1); caml_modify (&Field (bufv, 0), v); |
1078 |
|
#else |
1079 |
|
v = copy_int64 (buf->f_type); caml_modify (&Field (bufv, 0), v); |
1080 |
|
#endif /* ((defined (sun) || defined (__sun__))) || (defined(__FreeBSD__) && __FreeBSD_version >= 503001) || defined(__OpenBSD__) || defined(__NetBSD__) */ |
1081 |
|
v = copy_int64 (buf->f_bsize); caml_modify (&Field (bufv, 1), v); |
1082 |
|
v = copy_int64 (buf->f_blocks); caml_modify (&Field (bufv, 2), v); |
1083 |
|
v = copy_int64 (buf->f_bfree); caml_modify (&Field (bufv, 3), v); |
1084 |
|
v = copy_int64 (buf->f_bavail); caml_modify (&Field (bufv, 4), v); |
1085 |
|
v = copy_int64 (buf->f_files); caml_modify (&Field (bufv, 5), v); |
1086 |
|
v = copy_int64 (buf->f_ffree); caml_modify (&Field (bufv, 6), v); |
1087 |
|
#if ((defined (sun) || defined (__sun__))) |
1088 |
|
v = copy_int64 (-1); caml_modify (&Field (bufv, 7), v); |
1089 |
|
v = copy_int64 (buf->f_namemax); caml_modify (&Field (bufv, 8), v); |
1090 |
|
v = copy_string (buf->f_basetype); caml_modify (&Field (bufv, 9), v); |
1091 |
|
v = copy_int64 (buf->f_frsize); caml_modify (&Field (bufv, 10), v); |
1092 |
|
#else |
1093 |
|
#if (defined(__FreeBSD__) && __FreeBSD_version >= 503001) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__APPLE__) |
1094 |
|
# if defined(__OpenBSD__) || defined(__NetBSD__) |
1095 |
|
# include <sys/syslimits.h> |
1096 |
|
v = copy_int64 (NAME_MAX); caml_modify (&Field (bufv, 8), v); |
1097 |
|
# else |
1098 |
|
# if defined(__APPLE__) |
1099 |
|
# include <unistd.h> |
1100 |
|
v = copy_int64 (_PC_NAME_MAX); caml_modify (&Field (bufv ,8 ), v); |
1101 |
|
# else |
1102 |
|
v = copy_int64 (buf->f_namemax); caml_modify (&Field (bufv, 8), v); |
1103 |
|
# endif /* (__APPLE__) */ |
1104 |
|
# endif /* (__OpenBSD__) || defined(__NetBSD__) */ |
1105 |
|
v = copy_string (buf->f_fstypename); caml_modify (&Field (bufv, 9), v); |
1106 |
|
#else |
1107 |
|
v = copy_int64 (buf->f_namelen); caml_modify (&Field (bufv, 8), v); |
1108 |
|
v = copy_string ("-1"); caml_modify (&Field (bufv, 9), v); |
1109 |
|
#endif /* (defined(__FreeBSD__) && __FreeBSD_version >= 503001) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__APPLE__) */ |
1110 |
|
caml_modify (&Field (bufv, 7), Val_unit); |
1111 |
|
v = copy_int64 (-1); caml_modify (&Field (bufv, 10), v); |
1112 |
|
#endif /* ((defined (sun) || defined (__sun__))) */ |
1113 |
|
CAMLreturn (bufv); |
1114 |
|
} |
1115 |
|
#endif |
1116 |
|
|
1117 |
|
CAMLprim value |
1118 |
|
statfs_statfs (value pathv) |
1119 |
|
{ |
1120 |
|
#ifdef HAVE_STATS |
1121 |
|
CAMLparam1 (pathv); |
1122 |
|
CAMLlocal1 (bufv); |
1123 |
|
const char *path = String_val (pathv); |
1124 |
|
#if ((defined (sun) || defined (__sun__))) |
1125 |
|
struct statvfs buf; |
1126 |
|
if (statvfs (path, &buf) == -1) |
1127 |
|
#else |
1128 |
|
struct statfs buf; |
1129 |
|
if (statfs (path, &buf) == -1) |
1130 |
|
#endif |
1131 |
|
raise_constant(*(value *)caml_named_value("error")); |
1132 |
|
bufv = copy_statfs (&buf); |
1133 |
|
CAMLreturn (bufv); |
1134 |
|
#else |
1135 |
|
raise_constant(*(value *)caml_named_value("not supported")); |
1136 |
|
#endif |
1137 |
|
} |
1138 |
|
#endif /* defined(__MINGW32__) */ |