/* file.c * * $Id$ * * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin * Copyright 2002, 2003 Sam Hocevar , Paris * * This software was derived from Elk 1.2, which was Copyright 1987, 1988, * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project * between TELES and Nixdorf Microprocessor Engineering, Berlin). * * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co- * owners or individual owners of copyright in this software, grant to any * person or company a worldwide, royalty free, license to * * i) copy this software, * ii) prepare derivative works based on this software, * iii) distribute copies of this software or derivative works, * iv) perform this software, or * v) display this software, * * provided that this notice is not removed and that neither Oliver Laumann * nor Teles nor Nixdorf are deemed to have made any representations as to * the suitability of this software for any purpose nor are held responsible * for any defects of this software. * * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE. */ #include "unix.h" #include #ifdef HAVE_UTIME_H # include #elif HAVE_SYS_UTIME_H # include #else struct utimbuf { time_t actime, modtime; }; #endif #ifdef HAVE_DIRENT_H # include #else # include #endif #if defined(ELOOP) # define SYMLINKS #endif static SYMDESCR Access_Syms[] = { { "read", R_OK }, /* Nothing == F_OK */ { "write", W_OK }, { "execute", X_OK }, { 0, 0 } }; static Object P_Accessp(Object fn, Object mode) { if (access(Get_Strsym(fn), (int)Symbols_To_Bits(mode, 1, Access_Syms)) == 0) return True; Saved_Errno = errno; return False; } static Object P_Chdir(Object fn) { if (chdir(Get_Strsym(fn)) == -1) Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Chmod(Object fn, Object mode) { if (chmod(Get_Strsym(fn), Get_Integer(mode)) == -1) Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Chown(Object fn, Object uid, Object gid) { #ifndef WIN32 if (chown(Get_Strsym(fn), Get_Integer(uid), Get_Integer(gid)) == -1) Raise_System_Error1("~s: ~E", fn); #endif return Void; } static Object P_Link(Object fn1, Object fn2) { #ifndef WIN32 if (link(Get_Strsym(fn1), Get_Strsym(fn2)) == -1) Raise_System_Error2("(~s ~s): ~E", fn1, fn2); #endif return Void; } static Object P_Mkdir(Object fn, Object mode) { #ifndef WIN32 if (mkdir(Get_Strsym(fn), Get_Integer(mode)) == -1) Raise_System_Error1("~s: ~E", fn); #endif return Void; } static Object P_Read_Directory(Object fn) { DIR *d; #ifdef HAVE_DIRENT_H struct dirent *dp; #else struct direct *dp; #endif Object ret; GC_Node; ret = Null; GC_Link(ret); Disable_Interrupts; if ((d = opendir(Get_Strsym(fn))) == NULL) { Saved_Errno = errno; Enable_Interrupts; Raise_System_Error1("~s: cannot open", fn); } while ((dp = readdir(d)) != NULL) { Object x; x = Make_String(dp->d_name, strlen(dp->d_name)); ret = Cons(x, ret); } /* closedir() is void under 4.3BSD, should check result elsewhere. */ (void)closedir(d); Enable_Interrupts; GC_Unlink; return ret; } static Object P_Rename(Object fromfn, Object tofn) { #ifdef HAVE_RENAME if (rename(Get_Strsym(fromfn), Get_Strsym(tofn)) == -1) Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); #else char *from = Get_Strsym(fromfn), *to = Get_Strsym(tofn); Disable_Interrupts; if (link(from, to) == -1) { Saved_Errno = errno; Enable_Interrupts; Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); } if (unlink(from) == -1) { Saved_Errno = errno; (void)unlink(to); Enable_Interrupts; Raise_Error1("~s: ~E", fromfn); } Enable_Interrupts; #endif return Void; } static Object General_Stat(Object obj, Object ret, int l) { Object x; struct stat st; char *s, *fn = NULL; int fd = -1, result = 0; GC_Node; Check_Result_Vector(ret, 11); if (l) { #ifdef SYMLINKS result = lstat(Get_Strsym(obj), &st); #endif } else { Get_Filename_Or_Filedescr(obj, fd, fn); result = fn ? stat(fn, &st) : fstat(fd, &st); } if (result == -1) Raise_System_Error1("~s: ~E", obj); switch (st.st_mode & S_IFMT) { case S_IFDIR: s = "directory"; break; case S_IFCHR: s = "character-special"; break; case S_IFBLK: s = "block-special"; break; case S_IFREG: s = "regular"; break; #ifdef S_IFLNK case S_IFLNK: s = "symlink"; break; #endif #ifdef S_IFSOCK case S_IFSOCK: s = "socket"; break; #endif #ifdef S_IFFIFO case S_IFFIFO: s = "fifo"; break; #endif default: s = "unknown"; break; } /* Bad assumption: any of the st_ fields fits into an unsigned int. */ GC_Link(ret); x = Intern(s); VECTOR(ret)->data[0] = x; x = Make_Unsigned((unsigned)st.st_mode & ~S_IFMT); VECTOR(ret)->data[1] = x; x = Make_Unsigned_Long((unsigned long)st.st_ino); VECTOR(ret)->data[2] = x; x = Make_Unsigned((unsigned)st.st_dev); VECTOR(ret)->data[3] = x; x = Make_Unsigned((unsigned)st.st_nlink); VECTOR(ret)->data[4] = x; x = Make_Unsigned((unsigned)st.st_uid); VECTOR(ret)->data[5] = x; x = Make_Unsigned((unsigned)st.st_gid); VECTOR(ret)->data[6] = x; x = Make_Long((long)st.st_size); VECTOR(ret)->data[7] = x; x = Make_Unsigned_Long((unsigned long)st.st_atime); VECTOR(ret)->data[8] = x; x = Make_Unsigned_Long((unsigned long)st.st_mtime); VECTOR(ret)->data[9] = x; x = Make_Unsigned_Long((unsigned long)st.st_ctime); VECTOR(ret)->data[10] = x; GC_Unlink; return Void; } static Object P_Stat(Object obj, Object ret) { return General_Stat(obj, ret, 0); } #ifdef SYMLINKS static Object P_Lstat(Object obj, Object ret) { return General_Stat(obj, ret, 1); } static Object P_Readlink(Object fn) { char *buf; int len; Object ret; Alloca_Begin; len = Path_Max(); Alloca(buf, char*, len); if ((len = readlink(Get_Strsym(fn), buf, len)) == -1) { Alloca_End; Raise_System_Error1("~s: ~E", fn); } ret = Make_String(buf, len); Alloca_End; return ret; } static Object P_Rmdir(Object fn) { if (rmdir(Get_Strsym(fn)) == -1) Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Symlink(Object fn1, Object fn2) { if (symlink(Get_Strsym(fn1), Get_Strsym(fn2)) == -1) Raise_System_Error2("(~s ~s): ~E", fn1, fn2); return Void; } #endif static Object P_Unlink(Object fn) { if (unlink(Get_Strsym(fn)) == -1) Raise_System_Error1("~s: ~E", fn); return Void; } static Object P_Utime(int argc, Object *argv) { struct utimbuf ut; if (argc == 2) Primitive_Error("wrong number of arguments"); if (argc == 3) { ut.actime = (time_t)Get_Unsigned_Long(argv[1]); ut.modtime = (time_t)Get_Unsigned_Long(argv[2]); } #ifndef WIN32 if (utime(Get_Strsym(argv[0]), argc == 1 ? (struct utimbuf *)0 : &ut) == -1) Raise_System_Error1("~s: ~E", argv[0]); #endif return Void; } void elk_init_unix_file() { Def_Prim(P_Accessp, "unix-access?", 2, 2, EVAL); Def_Prim(P_Chdir, "unix-chdir", 1, 1, EVAL); Def_Prim(P_Chmod, "unix-chmod", 2, 2, EVAL); Def_Prim(P_Chown, "unix-chown", 3, 3, EVAL); Def_Prim(P_Link, "unix-link", 2, 2, EVAL); Def_Prim(P_Mkdir, "unix-mkdir", 2, 2, EVAL); Def_Prim(P_Read_Directory, "unix-read-directory", 1, 1, EVAL); Def_Prim(P_Rename, "unix-rename", 2, 2, EVAL); Def_Prim(P_Stat, "unix-stat-vector-fill!", 2, 2, EVAL); #ifdef SYMLINKS Def_Prim(P_Lstat, "unix-lstat-vector-fill!", 2, 2, EVAL); Def_Prim(P_Readlink, "unix-readlink", 1, 1, EVAL); Def_Prim(P_Rmdir, "unix-rmdir", 1, 1, EVAL); Def_Prim(P_Symlink, "unix-symlink", 2, 2, EVAL); P_Provide(Intern("unix:symlinks")); #endif Def_Prim(P_Unlink, "unix-unlink", 1, 1, EVAL); Def_Prim(P_Utime, "unix-utime", 1, 3, VARARGS); }