staload UNSAFE = "prelude/SATS/unsafe.sats"
staload "libc/SATS/errno.sats"
staload "libc/SATS/grp.sats"
staload "libc/SATS/pwd.sats"
staload "libc/SATS/time.sats"
staload "libc/SATS/unistd.sats"
staload "libc/sys/SATS/stat.sats"
staload "libc/sys/SATS/types.sats"
fun print_mode .<>.
(st: &stat): void = let
val mode = st.st_mode
macdef TYPE(b) = ,(b) = (mode land S_IFMT)
macdef MODE(b) = ,(b) = (mode land ,(b))
val () = case+ 0 of
| _ when TYPE(S_IFBLK) => print 'b'
| _ when TYPE(S_IFCHR) => print 'c'
| _ when TYPE(S_IFDIR) => print 'd'
| _ when TYPE(S_IFIFO) => print 'p'
| _ when TYPE(S_IFLNK) => print 'l'
| _ when TYPE(S_IFREG) => print '-'
| _ when TYPE(S_IFSOCK) => print 's'
| _ => print '?'
val () = if MODE(S_IRUSR) then print 'r' else print '-'
val () = if MODE(S_IWUSR) then print 'w' else print '-'
val () = case+ 0 of
| _ when MODE(S_ISUID) =>
if MODE(S_IXUSR) then print 's' else print 'S'
| _ =>
if MODE(S_IXUSR) then print 'x' else print '-'
val () = if MODE(S_IRGRP) then print 'r' else print '-'
val () = if MODE(S_IWGRP) then print 'w' else print '-'
val () = case+ 0 of
| _ when MODE(S_ISGID) =>
if MODE(S_IXGRP) then print 's' else print 'S'
| _ =>
if MODE(S_IXGRP) then print 'x' else print '-'
val () = if MODE(S_IROTH) then print 'r' else print '-'
val () = if MODE(S_IWOTH) then print 'w' else print '-'
val () = case+ 0 of
| _ when MODE(S_IFDIR) andalso MODE(S_ISVTX) =>
if MODE(S_IXOTH) then print 't' else print 'T'
| _ =>
if MODE(S_IXOTH) then print 'x' else print '-'
in
end
fun print_nlink .<>.
(st: &stat): void = let
val nlink = st.st_nlink
val nlink = lint_of_nlink (nlink)
in
printf ("%5ld", @(nlink))
end
fun print_owner .<>.
(st: &stat): void = let
val uid = st.st_uid
val (pfopt| p) = getpwuid (uid)
in
if p > null then let
prval Some_v @(pf, fpf) = pfopt
val (fpf_x | x) = passwd_get_pw_name (!p)
prval () = fpf (pf)
val () = assert_errmsg (strptr_isnot_null x, #LOCATION)
val () = printf (" %-8s", @(__cast x)) where {
extern castfn __cast {l:addr} (x: !strptr l):<> string
}
prval () = fpf_x (x)
in
end else let
prval None_v () = pfopt
val uid = lint_of_uid (uid)
in
printf (" %-8ld", @(uid))
end end
fun print_group .<>.
(st: &stat): void = let
val gid = st.st_gid
val (pfopt| p) = getgrgid (gid)
in
if p > null then let
prval Some_v @(pf, fpf) = pfopt
val (fpf_x | x) = group_get_gr_name (!p)
prval () = fpf (pf)
val () = assert_errmsg (strptr_isnot_null x, #LOCATION)
val () = printf (" %-8s", @(__cast x)) where {
extern castfn __cast {l:addr} (x: !strptr l):<> string
}
prval () = fpf_x (x)
in
end else let
prval None_v () = pfopt
val gid = lint_of_gid (gid)
in
printf (" %-8ld", @(gid))
end end
fun print_size .<>.
(st: &stat): void = let
val mode = st.st_mode
macdef TYPE(b) = ,(b) = (mode land S_IFMT)
macdef MODE(b) = ,(b) = (mode land ,(b))
in
case+ 0 of
| _ when (TYPE(S_IFCHR) orelse TYPE(S_IFBLK)) => let
val rdev = st.st_rdev
val rdev = uint_of_dev (rdev)
val u1 = rdev >> 8
val u2 = rdev land 0xFFU
in
printf ("%4u,%4u", @(u1, u2))
end | _ => let
val off = st.st_size
val off = lint_of_off (off)
val off = ulint_of (off)
in
printf ("%9lu", @(off))
end
end
fun print_date .<>.
(st: &stat): void = let
val now = time_get ()
in
if (lint_of_time)now >= 0L then let
val diff = difftime (now, st.st_mtime)
val (pfopt | p) = localtime (st.st_mtime)
val () = assert_errmsg (p > null, #LOCATION)
prval Some_v @(pf, fpf) = pfopt
var !p_buf with pf_buf = @[byte][64]()
val fmt = (
if (diff < 0.0 orelse diff > 60*60*24*182.5 ) then "%b %e %Y" else "%b %e %H:%M"
) : string
val _n = strftime (pf_buf | p_buf, 64, fmt, !p)
prval () = fpf (pf)
val str = __cast (p_buf) where {
extern castfn __cast (x: ptr): string } prval () = pf_buf := bytes_v_of_strbuf_v (pf_buf)
in
printf (" %s", @(str))
end else begin
printf (" ????????????", @())
end end
fun print_name .<>.
(st: &stat, name: !READ(string)): void = let
in
case+ 0 of
| _ when S_ISLNK
(st.st_mode) => let
val n = lint_of_off (st.st_size)
val n = n + 1L
val n = size_of_lint (n)
val n = size1_of_size (n)
val (pfgc, pf | p) = malloc_gc (n)
val n1 = readlink (pf | name, p, n)
val () = if (n1 >= 0) then let
val n1 = size1_of_ssize1 (n1)
val () = assert_errmsg (n1 < n, #LOCATION)
val () = bytes_strbuf_trans (pf | p, n1)
val () = printf (" %s -> %s", @($UNSAFE.castvwtp1{string}(name), __cast p)) where {
extern castfn __cast (x: ptr): string } prval () = pf := bytes_v_of_strbuf_v (pf)
in
end else
printf (" %s -> [can't read link]", @($UNSAFE.castvwtp1{string}(name)))
in
free_gc (pfgc, pf | p)
end | _ => printf (" %s", @($UNSAFE.castvwtp1{string}(name)))
end
fun longls .<>.
(st: &stat, path: string): void = let
val () = print_mode (st)
val () = print_nlink (st)
val () = print_owner (st)
val () = print_group (st)
val () = print_size (st)
val () = print_date (st)
val () = print_name (st, path)
val () = print_newline ()
in
end
implement
main {n} (argc, argv) = () where {
var i: natLte n
var st: stat? val () = for
(i := 1; i < argc; i := i+1) let
val path = argv.[i]
val _err = lstat_err (path, st)
val () = if _err >= 0 then let
prval () = opt_unsome {stat} (st)
val () = longls (st, path)
in
end else let
prval () = opt_unnone {stat} (st)
val () = printf ("longls: cannot access [%s]: No such file or directory\n", @(path))
in
end in
end }