Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/rt-transition/runtime/sml-basis-lib/file-sys.c
ViewVC logotype

Annotation of /sml/branches/rt-transition/runtime/sml-basis-lib/file-sys.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2982 - (view) (download) (as text)

1 : jhr 2898 /* file-sys.c
2 :     *
3 :     * COPYRIGHT (c) 2001 Bell labs, Lucent Technologies.
4 :     *
5 :     * Support for file-system operations in the SML'97 Basis.
6 :     */
7 :    
8 :     #include "ml-unixdep.h"
9 :     #include <sys/stat.h>
10 :     #include <unistd.h>
11 :     #include <errno.h>
12 :     #include <sys/param.h>
13 :     #include <stdio.h>
14 :     #include <utime.h>
15 :     #include "ml-values.h"
16 :     #include "ml-objects.h"
17 :     #include "ml-c.h"
18 :     #include "sml-basis.h"
19 :    
20 :     /* chDir:
21 :     */
22 :     ML_unit_t chDir (ml_state_t *msp,idl_string path)
23 :     {
24 :     int sts;
25 :    
26 :     sts = chdir(path);
27 :    
28 :     CHK_RETURN_UNIT(msp, sts)
29 :    
30 :     } /* end of chDir */
31 :    
32 :     /* getDir:
33 :     */
34 :     ML_string_t getDir (ml_state_t *msp)
35 :     {
36 :     char path[MAXPATHLEN];
37 :     char *sts;
38 :    
39 :     sts = getcwd(path, MAXPATHLEN);
40 :    
41 :     if (sts != NIL(char *))
42 :     return ML_CString (msp, path);
43 :     else if (errno != ERANGE)
44 :     return RAISE_SYSERR(msp, sts);
45 :     else {
46 :     ml_val_t p;
47 :     int buflen;
48 :     char *buf;
49 :    
50 :     buflen = 2*MAXPATHLEN;
51 :     buf = MALLOC(buflen);
52 :     if (buf == NIL(char*))
53 :     return RAISE_ERROR(msp, "no malloc memory");
54 :    
55 :     while ((sts = getcwd(buf, buflen)) == NIL(char *)) {
56 :     FREE (buf);
57 :     if (errno != ERANGE)
58 :     return RAISE_SYSERR(msp, sts);
59 :     else {
60 :     buflen = 2*buflen;
61 :     buf = MALLOC(buflen);
62 :     if (buf == NIL(char*))
63 :     return RAISE_ERROR(msp, "no malloc memory");
64 :     }
65 :     }
66 :    
67 :     p = ML_CString (msp, buf);
68 :     FREE (buf);
69 :    
70 :     return p;
71 :     }
72 :    
73 :     } /* end of getDir */
74 :    
75 :     /* mkDir:
76 :     */
77 :     ML_unit_t mkDir (ml_state_t *msp, idl_string path)
78 :     {
79 :     int sts;
80 :    
81 :     sts = mkdir (path, 0777);
82 :    
83 :     CHK_RETURN_UNIT(msp, sts)
84 :    
85 :     } /* end of mkDir */
86 :    
87 :     /* rmDir:
88 :     */
89 :     ML_unit_t rmDir (ml_state_t *msp, idl_string path)
90 :     {
91 :     int sts;
92 :    
93 :     sts = rmdir(path);
94 :    
95 :     CHK_RETURN_UNIT(msp, sts)
96 :    
97 :     } /* end of rmDir */
98 :    
99 :     /* isReg:
100 :     */
101 :     ML_bool_t isReg (ml_state_t *msp, idl_string path)
102 :     {
103 :     struct stat st;
104 :     int sts;
105 :    
106 :     if ((sts = stat(path, &st)) < 0) return RAISE_SYSERR(msp, sts);
107 :     else if (S_ISREG(st.st_mode)) return ML_true;
108 :     else return ML_false;
109 :    
110 :     } /* end of isReg */
111 :    
112 :     /* isDir:
113 :     */
114 :     ML_bool_t isDir (ml_state_t *msp, idl_string path)
115 :     {
116 :     struct stat st;
117 :     int sts;
118 :    
119 :     if ((sts = stat(path, &st)) < 0) return RAISE_SYSERR(msp, sts);
120 :     else if (S_ISDIR(st.st_mode)) return ML_true;
121 :     else return ML_false;
122 :    
123 :     } /* end of isDir */
124 :    
125 :     /* isLink:
126 :     */
127 :     ML_bool_t isLink (ml_state_t *msp, idl_string path)
128 :     {
129 :     struct stat st;
130 :     int sts;
131 :    
132 :     if ((sts = stat(path, &st)) < 0) return RAISE_SYSERR(msp, sts);
133 :     #ifdef S_ISLNK
134 :     else if (S_ISLNK(st.st_mode)) return ML_true;
135 :     #endif
136 :     else return ML_false;
137 :    
138 :     } /* end of isLink */
139 :    
140 :     /* readLink:
141 :     *
142 :     * Read the value of a symbolic link.
143 :     *
144 :     * The following implementation assumes that the system readlink
145 :     * fills the given buffer as much as possible, without nul-termination,
146 :     * and returns the number of bytes copied. If the buffer is not large
147 :     * enough, the return value will be at least the buffer size. In that
148 :     * case, we find out how big the link really is, allocate a buffer to
149 :     * hold it, and redo the readlink.
150 :     *
151 :     * Note that the above semantics are not those of POSIX, which requires
152 :     * null-termination on success, and only fills the buffer up to as most
153 :     * the penultimate byte even on failure.
154 :     */
155 :     ML_string_t readLink (ml_state_t *msp, idl_string path)
156 :     {
157 :     char buf[MAXPATHLEN];
158 :     int len;
159 :    
160 :     len = readlink(path, buf, MAXPATHLEN);
161 :    
162 :     if (len < 0)
163 :     return RAISE_SYSERR(msp, len);
164 :     else if (len < MAXPATHLEN) {
165 :     buf[len] = '\0';
166 :     return ML_CString (msp, buf);
167 :     }
168 :     else { /* buffer not big enough */
169 :     char *nbuf;
170 :     ml_val_t obj;
171 :     struct stat sbuf;
172 :     int res;
173 :     int nlen;
174 :    
175 :     /* Determine how big the link text is and allocate a buffer */
176 :     res = lstat (path, &sbuf);
177 :     if (res < 0)
178 :     return RAISE_SYSERR(msp, res);
179 :     nlen = sbuf.st_size + 1;
180 :     nbuf = MALLOC(nlen);
181 :     if (nbuf == 0)
182 :     return RAISE_ERROR(msp, "out of malloc memory");
183 :    
184 : jhr 2982 /* Try the readlink again. Give up on error or if len is still bigger
185 :     * than the buffer size.
186 :     */
187 : jhr 2898 len = readlink(path, buf, len);
188 :     if (len < 0)
189 :     return RAISE_SYSERR(msp, len);
190 :     else if (len >= nlen)
191 :     return RAISE_ERROR(msp, "readlink failure");
192 :    
193 :     nbuf[len] = '\0';
194 :     obj = ML_CString (msp, nbuf);
195 :     FREE (nbuf);
196 :     return obj;
197 :     }
198 :    
199 :     } /* end of readLink */
200 :    
201 :     /* fileSize:
202 :     */
203 :     ML_int32_t fileSize (ml_state_t *msp, idl_string path)
204 :     {
205 :     int sts;
206 :     struct stat st;
207 :     ml_val_t res;
208 :    
209 :     if ((sts = stat(path, &st)) < 0)
210 :     return RAISE_SYSERR(msp, sts);
211 :     else {
212 : jhr 2906 INT32_ALLOC (msp, res, (int)st.st_size);
213 : jhr 2898 return res;
214 :     }
215 :    
216 :     } /* end of fileSize */
217 :    
218 :     /* modTime:
219 :     */
220 :     ML_int32_t modTime (ml_state_t *msp, idl_string path)
221 :     {
222 :     struct stat st;
223 :     int sts;
224 :    
225 :     if ((sts = stat(path, &st)) < 0) return RAISE_SYSERR(msp, sts);
226 :     else {
227 :     ml_val_t t;
228 :     INT32_ALLOC(msp, t, st.st_mtime);
229 :     return t;
230 :     }
231 :    
232 :     } /* end of modTime */
233 :    
234 :     /* setTime:
235 :     */
236 :     ML_unit_t setTime (ml_state_t *msp, idl_string path, Time_t *t)
237 :     {
238 :     int sts;
239 :    
240 :     if (t == NIL(Time_t *))
241 :     /* set access and modification times to current time */
242 :     sts = utime (path, NIL(struct utimbuf *));
243 :     else {
244 :     struct utimbuf tb;
245 :    
246 :     tb.actime = t->seconds;
247 :     tb.modtime = t->seconds;
248 :     sts = utime(path, &tb);
249 :     }
250 :    
251 :     CHK_RETURN_UNIT(msp, sts);
252 :    
253 :     } /* end of setTime */
254 :    
255 :     /* remove:
256 :     */
257 :     ML_unit_t removeFile (ml_state_t *msp, idl_string path)
258 :     {
259 :     int sts;
260 :    
261 :     sts = unlink (path);
262 :    
263 :     CHK_RETURN_UNIT(msp, sts);
264 :    
265 :     } /* end of remove */
266 :    
267 :     /* rename:
268 :     */
269 :     ML_unit_t renameFile (ml_state_t *msp, idl_string old, idl_string new)
270 :     {
271 :     int sts;
272 :    
273 :     sts = rename (old, new);
274 :    
275 :     CHK_RETURN_UNIT (msp, sts);
276 :    
277 :     } /* end of rename */
278 :    
279 :     /* fileAccess:
280 :     */
281 :     ML_bool_t fileAccess (ml_state_t *msp, idl_string path, int mode)
282 :     {
283 :     int m = F_OK;
284 :    
285 :     if (mode & A_READ) m |= R_OK;
286 :     if (mode & A_WRITE) m |= W_OK;
287 :     if (mode & A_EXEC) m |= X_OK;
288 :    
289 :     if (access (path, m) == 0)
290 :     return ML_true;
291 : jhr 2911 else if ((errno == EACCES) || (errno == ENOENT) || (errno == ENOTDIR) || (errno == EROFS))
292 : jhr 2898 return ML_false;
293 :     else
294 :     return RAISE_SYSERR(msp, -1);
295 :    
296 :     } /* end of fileAccess */
297 :    
298 :     /* tmpName:
299 :     */
300 :     ML_string_t tmpName (ml_state_t *msp)
301 :     {
302 :     char buf[L_tmpnam];
303 :    
304 :     tmpnam (buf);
305 :    
306 :     return ML_CString (msp, buf);
307 :    
308 :     } /* end of tmpName */
309 :    
310 :     /* fileId:
311 :     */
312 :     ML_word8vec_t fileId (ml_state_t *msp, idl_string path)
313 :     {
314 :     struct stat st;
315 :     struct fid {
316 :     ino_t ino;
317 :     dev_t dev;
318 :     } fid;
319 :     int sts;
320 :     ml_val_t data, res;
321 :    
322 :     if ((sts = stat(path, &st)) < 0)
323 :     return RAISE_SYSERR(msp, sts);
324 :     else {
325 :     fid.ino = st.st_ino;
326 :     fid.dev = st.st_dev;
327 :     data = ML_CData (msp, &fid, sizeof(struct fid));
328 :     SEQHDR_ALLOC (msp, res, DESC_word8vec, data, sizeof(struct fid));
329 :     return res;
330 :     }
331 :    
332 :     } /* end of fileId */
333 :    
334 :     /* ioDescKind:
335 :     */
336 :     ML_int_t ioDescKind (ml_state_t *msp, ML_iodesc_t iod)
337 :     {
338 :     int fd = INT_MLtoC(iod);
339 :     struct stat st;
340 :     int sts;
341 :    
342 :     sts = fstat (fd, &st);
343 :    
344 :     if (sts < 0) return RAISE_SYSERR(msp, sts);
345 :     else if (S_ISREG(st.st_mode)) return INT_CtoML(IOD_KIND_FILE);
346 :     else if (S_ISDIR(st.st_mode)) return INT_CtoML(IOD_KIND_DIR);
347 :     else if (S_ISCHR(st.st_mode)) return INT_CtoML(IOD_KIND_TTY);
348 :     else if (S_ISBLK(st.st_mode)) return INT_CtoML(IOD_KIND_DEVICE);
349 :     else if (S_ISFIFO(st.st_mode)) return INT_CtoML(IOD_KIND_PIPE);
350 :     #ifdef S_ISLNK
351 :     else if (S_ISLNK(st.st_mode)) return INT_CtoML(IOD_KIND_SYMLINK);
352 :     #endif
353 :     #ifdef S_ISSOCK
354 :     else if (S_ISSOCK(st.st_mode)) return INT_CtoML(IOD_KIND_SOCKET);
355 :     #endif
356 :     else return RAISE_ERROR(msp, "ioDescKind: unknown file type");
357 :    
358 :     } /* end of ioDescKind */

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0