1 (* Copyright (C
) 2017 Matthew Fluet
.
2 * Copyright (C
) 1999-2006, 2008 Henry Cejtin
, Matthew Fluet
, Suresh
3 * Jagannathan
, and Stephen Weeks
.
4 * Copyright (C
) 1997-2000 NEC Research Institute
.
6 * MLton is released under a BSD
-style license
.
7 * See the file MLton
-LICENSE for details
.
10 structure PosixFileSys
: POSIX_FILE_SYS_EXTRA
=
12 structure Prim
= PrimitiveFFI
.Posix
.FileSys
14 structure FileDesc
= PrePosix
.FileDesc
15 structure GId
= PrePosix
.GId
16 structure PId
= PrePosix
.PId
17 structure Stat
= Prim
.Stat
18 structure UId
= PrePosix
.UId
20 structure Error
= PosixError
21 structure SysCall
= Error
.SysCall
23 (* Patch to make Time look like it deals
with C_Time
.t
24 * instead
of LargeInt
.int.
30 val fromSeconds
= fromSeconds
o C_Time
.toLargeInt
33 C_Time
.fromLargeInt (Time
.toSeconds t
)
34 handle Overflow
=> Error
.raiseSys Error
.inval
37 type file_desc
= FileDesc
.t
41 val fdToWord
= C_Fd
.castToSysWord
o FileDesc
.toRep
42 val wordToFD
= FileDesc
.fromRep
o C_Fd
.castFromSysWord
44 val fdToIOD
= PreOS
.IODesc
.fromRep
o FileDesc
.toRep
45 val iodToFD
= SOME
o FileDesc
.fromRep
o PreOS
.IODesc
.toRep
47 (*------------------------------------*)
49 (*------------------------------------*)
52 structure Prim
= Prim
.Dirstream
53 datatype dirstream
= DS
of C_DirP
.t option ref
57 NONE
=> Error
.raiseSys Error
.badf
60 type dirstream
= dirstream
64 val s
= NullString
.nullTerm s
67 ({errVal
= C_DirP
.castFromSysWord
0w0
}, fn () =>
68 (Prim
.openDir s
, fn d
=>
79 ({clear
= true, restart
= false,
80 errVal
= CUtil
.C_Pointer
.null
}, fn () =>
81 {return
= Prim
.readDir d
,
82 post
= fn cs
=> SOME cs
,
83 handlers
= [(Error
.cleared
, fn () => NONE
),
84 (* MinGW sets errno to ENOENT when it
87 (Error
.noent
, fn () => NONE
)]})
93 val s
= CUtil
.C_String
.toString cs
95 if s
= "." orelse s
= ".."
108 fun closedir (DS r
) =
111 | SOME d
=> (SysCall
.simple (fn () => Prim
.closeDir d
); r
:= NONE
)
115 SysCall
.simple (fn () => Prim
.chdir (NullString
.nullTerm s
))
118 val size
: int ref
= ref
1
119 fun make () = Array
.alloc (!size
)
120 val buffer
= ref (make ())
122 fun extractToChar (a
, c
) =
124 val n
= Array
.length a
125 (* find the null terminator
*)
128 then raise Fail
"extractToChar didn't find terminator"
129 else if c
= Array
.sub (a
, i
)
133 ArraySlice
.vector (ArraySlice
.slice (a
, 0, SOME (loop
0)))
136 fun extract a
= extractToChar (a
, #
"\000")
142 ({clear
= false, restart
= false,
143 errVal
= CUtil
.C_Pointer
.null
}, fn () =>
144 {return
= Prim
.getcwd (!buffer
, C_Size
.fromInt (!size
)),
146 handlers
= [(Error
.range
, fn _
=> false)]})
149 then extract (!buffer
)
150 else (size
:= 2 * !size
156 val stdin
: file_desc
= FileDesc
.fromRep
0
157 val stdout
: file_desc
= FileDesc
.fromRep
1
158 val stderr
: file_desc
= FileDesc
.fromRep
2
162 structure Flags
= BitFlags(structure S
= C_Mode
)
192 structure Flags
= BitFlags(structure S
= C_Int
)
200 val nonblock
= NONBLOCK
210 datatype open_mode
= O_RDONLY | O_WRONLY | O_RDWR
212 fun flagsToOpenMode f
=
213 if f
= O
.rdonly
then O_RDONLY
214 else if f
= O
.wronly
then O_WRONLY
215 else if f
= O
.rdwr
then O_RDWR
216 else raise Fail
"flagsToOpenMode: unknown flag"
218 val openModeToFlags
=
219 fn O_RDONLY
=> O
.rdonly
220 | O_WRONLY
=> O
.wronly
223 fun createf (pathname
, openMode
, flags
, mode
) =
225 val pathname
= NullString
.nullTerm pathname
226 val flags
= O
.Flags
.flags
[openModeToFlags openMode
,
229 val flags
= C_Int
.castFromSysWord (O
.Flags
.toWord flags
)
232 (fn () => Prim
.open3 (pathname
, flags
, mode
))
237 fun openf (pathname
, openMode
, flags
) =
239 val pathname
= NullString
.nullTerm pathname
240 val flags
= O
.Flags
.flags
[openModeToFlags openMode
, flags
]
241 val flags
= C_Int
.castFromSysWord (O
.Flags
.toWord flags
)
244 (fn () => Prim
.open3 (pathname
, flags
, C_Mode
.castFromSysWord
0wx0
))
249 fun creat (s
, m
) = createf (s
, O_WRONLY
, O
.trunc
, m
)
251 val umask
= Prim
.umask
255 fun wrap p arg
= (SysCall
.simple (fn () => p arg
); ())
256 fun wrapRestart p arg
= (SysCall
.simpleRestart (fn () => p arg
); ())
258 wrap (fn {old
,new
} => p (NullString
.nullTerm old
,
259 NullString
.nullTerm new
))
261 val link
= wrapOldNew Prim
.link
262 val mkdir
= wrap (fn (p
, m
) => Prim
.mkdir (NullString
.nullTerm p
, m
))
263 val mkfifo
= wrap (fn (p
, m
) => Prim
.mkfifo (NullString
.nullTerm p
, m
))
264 val unlink
= wrap (Prim
.unlink
o NullString
.nullTerm
)
265 val rmdir
= wrap (Prim
.rmdir
o NullString
.nullTerm
)
266 val rename
= wrapOldNew Prim
.rename
267 val symlink
= wrapOldNew Prim
.symlink
271 Prim
.chmod (NullString
.nullTerm p
, m
))
275 Prim
.fchmod (FileDesc
.toRep fd
, m
))
279 Prim
.chown (NullString
.nullTerm s
, UId
.toRep uid
, GId
.toRep gid
))
282 (fn (fd
, uid
, gid
) =>
283 Prim
.fchown (FileDesc
.toRep fd
, UId
.toRep uid
, GId
.toRep gid
))
287 Prim
.ftruncate (FileDesc
.toRep fd
, n
))
292 val buf
: char array
= Array
.array (size
, #
"\000")
294 fun readlink (path
: string): string =
296 val path
= NullString
.nullTerm path
299 ({errVal
= C_SSize
.castFromFixedInt ~
1}, fn () =>
300 (Prim
.readlink (path
, buf
, C_Size
.fromInt size
), fn len
=>
301 ArraySlice
.vector (ArraySlice
.slice (buf
, 0, SOME (C_SSize
.toInt len
)))))
306 val wordToDev
= C_Dev
.castFromSysWord
307 val devToWord
= C_Dev
.castToSysWord
310 val wordToIno
= C_INo
.castFromSysWord
311 val inoToWord
= C_INo
.castToSysWord
328 T
{dev
= Stat
.getDev (),
329 ino
= Stat
.getINo (),
330 mode
= Stat
.getMode (),
331 nlink
= C_NLink
.toInt (Stat
.getNLink ()),
332 uid
= UId
.fromRep (Stat
.getUId ()),
333 gid
= GId
.fromRep (Stat
.getGId ()),
334 size
= Stat
.getSize (),
335 atime
= Time
.fromSeconds (Stat
.getATime ()),
336 mtime
= Time
.fromSeconds (Stat
.getMTime ()),
337 ctime
= Time
.fromSeconds (Stat
.getCTime ())}
340 fun make
sel (T r
) = sel r
342 val mode
= make #mode
345 val nlink
= make #nlink
348 val size
= make #size
349 val atime
= make #atime
350 val mtime
= make #mtime
351 val ctime
= make #ctime
355 fun make prim s
= prim (mode s
) <> C_Int
.zero
357 val isDir
= make Prim
.ST
.isDir
358 val isChr
= make Prim
.ST
.isChr
359 val isBlk
= make Prim
.ST
.isBlk
360 val isReg
= make Prim
.ST
.isReg
361 val isFIFO
= make Prim
.ST
.isFIFO
362 val isLink
= make Prim
.ST
.isLink
363 val isSock
= make Prim
.ST
.isSock
369 SysCall
.syscall (fn () => (prim arg
, fn _
=> ST
.fromC ()))
371 val stat
= (make Prim
.Stat
.stat
) o NullString
.nullTerm
372 val lstat
= (make Prim
.Stat
.lstat
) o NullString
.nullTerm
373 val fstat
= (make Prim
.Stat
.fstat
) o FileDesc
.toRep
376 datatype access_mode
= A_READ | A_WRITE | A_EXEC
378 val conv_access_mode
=
383 fun access (path
: string, mode
: access_mode list
): bool =
385 val mode
= List.foldl C_Int
.orb
0 (A
.F_OK
:: (map conv_access_mode mode
))
386 val path
= NullString
.nullTerm path
389 ({clear
= false, restart
= false, errVal
= C_Int
.fromInt ~
1}, fn () =>
390 {return
= Prim
.access (path
, mode
),
392 handlers
= [(Error
.acces
, fn () => false),
393 (Error
.loop
, fn () => false),
394 (Error
.nametoolong
, fn () => false),
395 (Error
.noent
, fn () => false),
396 (Error
.notdir
, fn () => false),
397 (Error
.rofs
, fn () => false)]})
401 structure U
= Prim
.Utimbuf
403 fun utime (f
: string, opt
: {actime
: Time
.time
,
404 modtime
: Time
.time
} option
): unit
=
408 NONE
=> let val t
= Time
.now ()
411 | SOME
{actime
= a
, modtime
= m
} => (a
, m
)
412 val a
= Time
.toSeconds a
413 val m
= Time
.toSeconds m
414 val f
= NullString
.nullTerm f
416 SysCall
.syscallRestart
420 ; (U
.utime f
, fn _
=>
430 if n
= C_Int
.fromInt ~
1
435 (TWO_SYMLINKS
,"2_SYMLINKS") ::?
436 (ALLOC_SIZE_MIN
,"ALLOC_SIZE_MIN") ::?
437 (ASYNC_IO
,"ASYNC_IO") ::?
438 (CHOWN_RESTRICTED
,"CHOWN_RESTRICTED") ::?
439 (FILESIZEBITS
,"FILESIZEBITS") ::?
440 (LINK_MAX
,"LINK_MAX") ::?
441 (MAX_CANON
,"MAX_CANON") ::?
442 (MAX_INPUT
,"MAX_INPUT") ::?
443 (NAME_MAX
,"NAME_MAX") ::?
444 (NO_TRUNC
,"NO_TRUNC") ::?
445 (PATH_MAX
,"PATH_MAX") ::?
446 (PIPE_BUF
,"PIPE_BUF") ::?
447 (PRIO_IO
,"PRIO_IO") ::?
448 (REC_INCR_XFER_SIZE
,"REC_INCR_XFER_SIZE") ::?
449 (REC_MAX_XFER_SIZE
,"REC_MAX_XFER_SIZE") ::?
450 (REC_MIN_XFER_SIZE
,"REC_MIN_XFER_SIZE") ::?
451 (REC_XFER_ALIGN
,"REC_XFER_ALIGN") ::?
452 (SYMLINK_MAX
,"SYMLINK_MAX") ::?
453 (SYNC_IO
,"SYNC_IO") ::?
454 (VDISABLE
,"VDISABLE") ::?
458 fun convertProperty s
=
459 case List.find (fn (_
, s
') => s
= s
') properties
of
460 NONE
=> Error
.raiseSys Error
.inval
463 fun make
prim (f
, s
) =
465 ({clear
= true, restart
= false, errVal
= C_Long
.fromInt ~
1}, fn () =>
466 {return
= prim (f
, convertProperty s
),
467 post
= fn ret
=> SOME (SysWord
.fromLargeInt (C_Long
.toLarge ret
)),
468 handlers
= [(Error
.cleared
, fn () => NONE
)]})
470 val pathconf
= make (fn (path
, s
) => Prim
.pathconf (NullString
.nullTerm path
, s
))
471 val fpathconf
= make (fn (fd
, s
) => Prim
.fpathconf (FileDesc
.toRep fd
, s
))