307 lines
8.6 KiB
C
307 lines
8.6 KiB
C
/* file.c
|
|
*
|
|
* $Id$
|
|
*
|
|
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
|
* Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, 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 <string.h>
|
|
|
|
#ifdef HAVE_UTIME_H
|
|
# include <utime.h>
|
|
#elif HAVE_SYS_UTIME_H
|
|
# include <sys/utime.h>
|
|
#else
|
|
struct utimbuf {
|
|
time_t actime, modtime;
|
|
};
|
|
#endif
|
|
|
|
#ifdef HAVE_DIRENT_H
|
|
# include <dirent.h>
|
|
#else
|
|
# include <sys/dir.h>
|
|
#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);
|
|
}
|