## posix-file.pkg
#
# Package for POSIX 1003.1 file system operations
### "I stopped believing in Santa Claus when I was six.
### Mother took me to see him in a department store
### and he asked for my autograph."
###
### -- Shirley Temple
stipulate
package host_unt = host_unt_guts
package one_word_unt = Word32Imp
package time = TimeImp
package ci = mythryl_callable_c_library_interface; # mythryl_callable_c_library_interface is from src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkg #
fun cfun fun_name
=
ci::find_c_function { lib_name => "posix_filesys", fun_name };
#
# If this code is re-activated it should be converted from using
# find_c_function to using find_c_function' -- for a model see
# src/lib/std/src/psx/posix-file.pkg # -- 2012-04-24 Crt
herein
package posix_file {
#
my ++ = host_unt::bitwise_or
my & = host_unt::bitwise_and
infix ++ &
type unt = host_unt::unt
type s_int = host_int::int
my osval: String -> s_int = cfun "osval"; # osval def in src/c/lib/posix-file-system/osval.c
#
w_osval = host_unt::from_int o osval
enum uid = UID of unt
enum gid = GID of unt
enum File_Descriptor = FD of { fd: s_int }
fun intOf (FD { fd, ... } ) = fd
fun fd fd = FD { fd=fd }
fun fdToUnt (FD { fd, ... } ) = host_unt::from_int fd
fun untToFD fd = FD { fd = host_unt::toInt fd }
# inline_t is from src/lib/core/init/built-in.pkg # file_position::Int <-> hi & lo parts
splitpos = inline_t::Int2::extern
joinpos = inline_t::Int2::intern
# Conversions between winix::io::Iod values and Posix file descriptors.
fun fdToIOD (FD { fd, ... } ) = winix__premicrothread::io::IODESC fd
fun iodToFD (winix__premicrothread::io::IODESC fd) = THE (FD { fd = fd } )
o_rdonly = w_osval "O_RDONLY"
o_wronly = w_osval "O_WRONLY"
o_rdwr = w_osval "O_RDWR"
enum open_mode = O_RDONLY | O_WRONLY | O_RDWR
fun omodeFromUnt omode =
if omode == o_rdonly then O_RDONLY
else if omode == o_wronly then O_WRONLY
else if omode == o_rdwr then O_RDWR
else raise exception DIE ("posix_file::omodeFromUnt: unknown mode " $
(one_word_unt::to_string omode))
fun omodeToUnt O_RDONLY = o_rdonly
| omodeToUnt O_WRONLY = o_wronly
| omodeToUnt O_RDWR = o_rdwr
fun uidToUnt (UID i) = i
fun untToUid i = UID i
fun gidToUnt (GID i) = i
fun untToGid i = GID i
type c_dirstream = assembly::chunk # the underlying C DIRSTREAM
enum Directory_Stream = DS of {
dirStrm: c_dirstream,
isOpen: Ref( Bool )
}
my opendir' : String -> Ckit_Dirstream = cfun "opendir"; # opendir def in src/c/lib/posix-file-system/opendir.c
my readdir' : Ckit_Dirstream -> String = cfun "readdir"; # readdir def in src/c/lib/posix-file-system/readdir.c
my rewinddir' : Ckit_Dirstream -> Void = cfun "rewinddir"; # rewinddir def in src/c/lib/posix-file-system/rewinddir.c
my closedir' : Ckit_Dirstream -> Void = cfun "closedir"; # closedir def in src/c/lib/posix-file-system/closedir.c
fun opendir path = DS {
dirStrm = opendir' path,
isOpen = REF TRUE
};
fun readdir (DS { dirStrm, isOpen = REF FALSE } ) =
raise exception assembly::RUNTIME_EXCEPTION("readdir on closed directory stream", NULL)
| readdir (DS { dirStrm, ... } ) =
case readdir' dirStrm of
"" => NULL
| name => THE name
fun rewinddir (DS { dirStrm, isOpen = REF FALSE } ) =
raise exception assembly::RUNTIME_EXCEPTION("rewinddir on closed directory stream", NULL)
| rewinddir (DS { dirStrm, ... } ) = rewinddir' dirStrm
fun closedir (DS { dirStrm, isOpen = REF FALSE } ) = ()
| closedir (DS { dirStrm, isOpen } ) = (
isOpen := FALSE;
closedir' dirStrm)
my change_directory: String -> Void = cfun "chdir"; # chdir def in src/c/lib/posix-file-system/chdir.c
my current_directory: Void -> String = cfun "getcwd"; # getcwd def in src/c/lib/posix-file-system/getcwd.c
stdin = fd 0
stdout = fd 1
stderr = fd 2
package s {
local package bf = bit_flags_g ()
in
use BF
type mode = flags
end
irwxu = fromUnt (w_osval "irwxu")
irusr = fromUnt (w_osval "irusr")
iwusr = fromUnt (w_osval "iwusr")
ixusr = fromUnt (w_osval "ixusr")
irwxg = fromUnt (w_osval "irwxg")
irgrp = fromUnt (w_osval "irgrp")
iwgrp = fromUnt (w_osval "iwgrp")
ixgrp = fromUnt (w_osval "ixgrp")
irwxo = fromUnt (w_osval "irwxo")
iroth = fromUnt (w_osval "iroth")
iwoth = fromUnt (w_osval "iwoth")
ixoth = fromUnt (w_osval "ixoth")
isuid = fromUnt (w_osval "isuid")
isgid = fromUnt (w_osval "isgid")
}
package o {
local package bf = bit_flags_g ()
in
use BF
end
append = fromUnt (w_osval "O_APPEND")
dsync = fromUnt (w_osval "O_DSYNC")
excl = fromUnt (w_osval "O_EXCL")
noctty = fromUnt (w_osval "O_NOCTTY")
nonblock = fromUnt (w_osval "O_NONBLOCK")
rsync = fromUnt (w_osval "O_RSYNC")
sync = fromUnt (w_osval "O_SYNC")
o_trunc = w_osval "O_TRUNC"
trunc = fromUnt o_trunc
o_creat = w_osval "O_CREAT"
crflags = o_wronly ++ o_creat ++ o_trunc
}
my mkstemp' : Void -> host_int::Int # Opens a temporary file and returns the fd -- see man 3 mkfstemp
=
cfun "mkstemp"; # mkstemp def in src/c/lib/posix-file-system/mkstemp.c
fun mkstemp ()
=
int_to_fd (mkstemp' ());
my openf' : (String, host_unt::Unt, host_unt::Unt) -> host_int::Int = cfun "openf"; # openf def in src/c/lib/posix-file-system/openf.c
#
fun openf (fname, omode, flags)
=
fd (openf'(fname, o::toUnt flags ++ (omodeToUnt omode), 0w0))
#
fun createf (fname, omode, oflags, mode)
=
let
flags = o::o_creat ++ o::toUnt oflags ++ (omodeToUnt omode)
in
fd (openf'(fname, flags, s::toUnt mode))
end
#
fun creat (fname, mode)
=
fd (openf'(fname, o::crflags, s::toUnt mode))
my umask' : host_unt::Unt -> host_unt::Unt = cfun "umask"; # umask def in src/c/lib/posix-file-system/umask.c
#
fun umask mode
=
s::fromUnt (umask' (s::toUnt mode));
my link' : (String, String) -> Void = cfun "link"; # link def in src/c/lib/posix-file-system/link.c
#
fun link { old, new }
=
link' (old, new);
my rename' : (String, String) -> Void = cfun "rename"; # rename def in src/c/lib/posix-file-system/rename.c
#
fun rename { old, new }
=
rename' (old, new);
my symlink' : (String, String) -> Void = cfun "symlink"; # symlink def in src/c/lib/posix-file-system/symlink.c
#
fun symlink { old, new }
=
symlink'(old, new);
my mkdir' : (String, host_unt::Unt) -> Void = cfun "mkdir"; # mkdir def in src/c/lib/posix-file-system/mkdir.c
#
fun mkdir (dirname, mode)
=
mkdir'(dirname, s::toUnt mode);
my mkfifo' : (String, host_unt::Unt) -> Void = cfun "mkfifo"; # mkfifo def in src/c/lib/posix-file-system/mkfifo.c
#
fun mkfifo (name, mode)
=
mkfifo' (name, s::toUnt mode);
my unlink: String -> Void = cfun "unlink"; # unlink def in src/c/lib/posix-file-system/unlink.c
my rmdir: String -> Void = cfun "rmdir"; # rmdir def in src/c/lib/posix-file-system/rmdir.c
my readlink: String -> String = cfun "readlink"; # readlink def in src/c/lib/posix-file-system/readlink.c
my ftruncate' : s_int * unt * unt -> Void = cfun "ftruncate_64"; # ftruncate_64 def in src/c/lib/posix-file-system/ftruncate_64.c
#
fun ftruncate (FD { fd, ... }, len) =
let my (lhi, llo) = splitpos len
in ftruncate' (fd, lhi, llo)
end
enum dev = DEV of unt
fun devToUnt (DEV i) = i
fun untToDev i = DEV i
enum ino = INO of unt
fun inoToUnt (INO i) = i
fun untToIno i = INO i
package st {
enum Stat = ST of {
ftype: s_int,
mode: s::mode,
ino: ino,
dev: dev,
nlink: Int,
uid: uid,
gid: gid,
size: file_position::Int,
atime: time::time,
mtime: time::time,
ctime: time::time
}
# The following assumes the C stat functions pull the
# file type from the mode field and return the
# integer below corresponding to the file type.
fun is_directory (ST { ftype, ... } ) = (ftype = 0x4000)
fun isChr (ST { ftype, ... } ) = (ftype = 0x2000)
fun isBlk (ST { ftype, ... } ) = (ftype = 0x6000)
fun isReg (ST { ftype, ... } ) = (ftype = 0x8000)
fun isFIFO (ST { ftype, ... } ) = (ftype = 0x1000)
fun is_symbolic_link (ST { ftype, ... } ) = (ftype = 0xA000)
fun isSock (ST { ftype, ... } ) = (ftype = 0xC000)
fun mode (ST { mode, ... } ) = mode
fun ino (ST { ino, ... } ) = ino
fun dev (ST { dev, ... } ) = dev
fun nlink (ST { nlink, ... } ) = nlink
fun uid (ST { uid, ... } ) = uid
fun gid (ST { gid, ... } ) = gid
fun size (ST { size, ... } ) = size
fun atime (ST { atime, ... } ) = atime
fun mtime (ST { mtime, ... } ) = mtime
fun ctime (ST { ctime, ... } ) = ctime
} /* package st */
# This layout needs to track src/c/lib/posix-file-system/stat.c
type statrep =
( s_int # file type
* unt # mode
* unt # ino
* unt # Devno
* unt # nlink
* unt # uid
* unt # gid
* unt # sizehi
* unt # sizelo
* one_word_int::Int # Atime
* one_word_int::Int # mtime
* one_word_int::Int # Ctime
)
fun mkStat ((ft, m, ino, devno, nlink, uid, gid,
szhi, szlo, at, mt, ct) : statrep) =
st::ST { ftype = ft,
mode = s::fromUnt m,
ino = INO ino,
dev = DEV devno,
nlink = host_unt::toInt nlink, /* probably should be an int in
* the run-time too.
*/
uid = UID uid,
gid = GID gid,
size = joinpos (szhi, szlo),
atime = time::from_seconds (Int1Imp::toLarge at),
mtime = time::from_seconds (Int1Imp::toLarge mt),
ctime = time::from_seconds (Int1Imp::toLarge ct) }
my stat' : String -> statrep = cfun "stat_64"; # stat_64 def in src/c/lib/posix-file-system/stat_64.c
my lstat' : String -> statrep = cfun "lstat_64"; # lstat_64 def in src/c/lib/posix-file-system/stat_64.c
my fstat' : s_int -> statrep = cfun "fstat_64"; # fstat_64 def in src/c/lib/posix-file-system/stat_64.c
fun stat fname = mkStat (stat' fname)
fun lstat fname = mkStat (lstat' fname) # POSIX 1003.1a
fun fstat (FD { fd } ) = mkStat (fstat' fd)
enum Access_Mode = MAY_READ | MAY_WRITE | MAY_EXECUTE
a_read = w_osval "MAY_READ" # R_OK
a_write = w_osval "MAY_WRITE" # W_OK
a_exec = w_osval "MAY_EXECUTE" # X_OK
a_file = w_osval "FILE_EXISTS" # F_OK
fun amodeToUnt [] = a_file
| amodeToUnt l = let
fun amtoi (MAY_READ, v) = a_read ++ v
| amtoi (MAY_WRITE, v) = a_write ++ v
| amtoi (MAY_EXECUTE, v) = a_exec ++ v
in
list::fold_forward amtoi a_file l
end
my access' : (String, host_unt::Unt) -> Bool = cfun "access"; # access def in src/c/lib/posix-file-system/access.c
#
fun access (fname, aml)
=
access' (fname, amode_to_unt aml);
my chmod' : (String, host_unt::Unt) -> Void = cfun "chmod"; # chmod def in src/c/lib/posix-file-system/chmod.c
#
fun chmod (fname, m)
=
chmod' (fname, s::toUnt m);
my fchmod' : (host_int::Int, host_unt::Unt) -> Void = cfun "fchmod"; # fchmod def in src/c/lib/posix-file-system/fchmod.c
#
fun fchmod (fd, m)
=
fchmod'(fd, s::toUnt m);
my chown' : (String, host_unt::Unt, host_unt::Unt) -> Void = cfun "chown"; # chown def in src/c/lib/posix-file-system/chown.c
#
fun chown (fname, UID uid, GID gid)
=
chown' (fname, uid, gid);
my fchown' : (host_int::Int, host_unt::Unt, host_unt::Unt) -> Void = cfun "fchown"; # fchown def in src/c/lib/posix-file-system/fchown.c
#
fun fchown (fd, UID uid, GID gid)
=
fchown'(intOf fd, uid, gid);
my utime' : (String, one_word_int::Int, one_word_int::Int) -> Void = cfun "utime"; # utime def in src/c/lib/posix-file-system/utime.c
#
fun utime (file, NULL)
=>
utime' (file, -1, 0)
utime (file, THE { actime, modtime } )
=>
let
atime = Int1Imp::fromLarge (time::to_seconds actime)
mtime = Int1Imp::fromLarge (time::to_seconds modtime)
in
utime'(file, atime, mtime)
end
end;
my pathconf: (String, String) -> Null_Or(host_unt::Unt)
=
cfun "pathconf"; # pathconf def in src/c/lib/posix-file-system/pathconf.c
my fpathconf' : (s_int * String) -> Null_Or( unt )
=
cfun "fpathconf" # fpathconf def in src/c/lib/posix-file-system/pathconf.c
fun fpathconf (FD { fd }, s) = fpathconf'(fd, s)
}; # package posix_file
end