void
lock_file (Lisp_Object fn)
{
register Lisp_Object attack, orig_fn, encoded_fn;
register char *lfname, *locker;
lock_info_type lock_info;
struct gcpro gcpro1;
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
if (! NILP (Vpurify_flag))
return;
orig_fn = fn;
GCPRO1 (fn);
fn = Fexpand_file_name (fn, Qnil);
encoded_fn = ENCODE_FILE (fn);
/* Create the name of the lock-file for file fn */
MAKE_LOCK_NAME (lfname, encoded_fn);
/* See if this file is visited and has changed on disk since it was
visited. */
{
register Lisp_Object subject_buf;
subject_buf = get_truename_buffer (orig_fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn)))
call1 (intern ("ask-user-about-supersession-threat"), fn);
}
UNGCPRO;
/* Try to lock the lock. */
if (lock_if_free (&lock_info, lfname) <= 0)
/* Return now if we have locked it, or if lock creation failed */
return;
/* Else consider breaking the lock */
locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
+ LOCK_PID_MAX + 9);
sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
lock_info.pid);
FREE_LOCK_INFO (lock_info);
attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
if (!NILP (attack))
/* User says take the lock */
{
lock_file_1 (lfname, 1);
return;
}
/* User says ignore the lock */
}
void
unlock_file (register Lisp_Object fn)
{
register char *lfname;
fn = Fexpand_file_name (fn, Qnil);
fn = ENCODE_FILE (fn);
MAKE_LOCK_NAME (lfname, fn);
if (current_lock_owner (0, lfname) == 2)
unlink (lfname);
}
static void
chdir_to_default_directory (void)
{
Lisp_Object new_cwd;
int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);
if (old_cwd_fd == -1)
error ("could not open current directory: %s", strerror (errno));
record_unwind_protect_int (fchdir_unwind, old_cwd_fd);
new_cwd = Funhandled_file_name_directory (
Fexpand_file_name (build_string ("."), Qnil));
if (!STRINGP (new_cwd))
new_cwd = build_string ("/");
if (chdir (SSDATA (ENCODE_FILE (new_cwd))))
error ("could not chdir: %s", strerror (errno));
}
DESCRIPTOR is the same object as the one returned by this function.
ACTIONS is a list of events.
FILE is the name of the file whose event is being reported. FILE1
will be reported only in case of the `rename' event. This is possible
only when the upper directory of the renamed file is watched. */)
(Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
{
Lisp_Object watch_object, dir_list;
int fd, oflags;
u_short fflags = 0;
struct kevent kev;
/* Check parameters. */
CHECK_STRING (file);
file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
if (NILP (Ffile_exists_p (file)))
report_file_error ("File does not exist", file);
CHECK_LIST (flags);
if (! FUNCTIONP (callback))
wrong_type_argument (Qinvalid_function, callback);
if (kqueuefd < 0)
{
/* Create kqueue descriptor. */
kqueuefd = kqueue ();
if (kqueuefd < 0)
report_file_notify_error ("File watching is not available", Qnil);
}
DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
doc: /* Return a list of names of files in DIRECTORY.
There are three optional arguments:
If FULL is non-nil, return absolute file names. Otherwise return names
that are relative to the specified directory.
If MATCH is non-nil, mention only file names that match the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
Otherwise, the list returned is sorted with `string-lessp'.
NOSORT is useful if you plan to sort the result yourself. */)
(Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
{
Lisp_Object handler;
directory = Fexpand_file_name (directory, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (directory, Qdirectory_files);
if (!NILP (handler))
return call5 (handler, Qdirectory_files, directory,
full, match, nosort);
return directory_files_internal (directory, full, match, nosort, 0, Qnil);
}
DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
Sdirectory_files_and_attributes, 1, 5, 0,
doc: /* Return a list of names of files and their attributes in DIRECTORY.
There are four optional arguments:
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format)
{
DIR *d;
int directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
int needsep = 0;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DIRENTRY *dp;
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
GCPRO5 (match, directory, list, dirfilename, encoded_directory);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
{
CHECK_STRING (match);
/* MATCH might be a flawed regular expression. Rather than
catching and signaling our own errors, we just call
compile_pattern to do the work for us. */
/* Pass 1 for the MULTIBYTE arg
because we do make multibyte strings if the contents warrant. */
# ifdef WINDOWSNT
/* Windows users want case-insensitive wildcards. */
bufp = compile_pattern (match, 0,
BVAR (&buffer_defaults, case_canon_table), 0, 1);
# else /* !WINDOWSNT */
bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif /* !WINDOWSNT */
}
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
if (STRING_MULTIBYTE (dirfilename))
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = (STRING_MULTIBYTE (directory)
? ENCODE_FILE (directory) : directory);
/* Now *bufp is the compiled form of MATCH; don't call anything
which might compile a new regexp until we're done with the loop! */
BLOCK_INPUT;
d = opendir (SSDATA (dirfilename));
UNBLOCK_INPUT;
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect (directory_files_internal_unwind,
make_save_value (d, 0));
#ifdef WINDOWSNT
if (attrs)
{
extern int is_slow_fs (const char *);
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call Ffile_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
if (EQ (Vw32_get_true_file_attributes, Qlocal))
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
if (is_slow_fs (SDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
}
}
#endif
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
/* Loop reading blocks until EOF or error. */
for (;;)
{
errno = 0;
dp = readdir (d);
if (dp == NULL && (0
#ifdef EAGAIN
|| errno == EAGAIN
#endif
#ifdef EINTR
|| errno == EINTR
#endif
))
{ QUIT; continue; }
if (dp == NULL)
break;
if (DIRENTRY_NONEMPTY (dp))
{
int len;
int wanted = 0;
Lisp_Object name, finalname;
struct gcpro gcpro1, gcpro2;
len = NAMLEN (dp);
name = finalname = make_unibyte_string (dp->d_name, len);
GCPRO2 (finalname, name);
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
immediate_quit = 1;
QUIT;
if (NILP (match)
|| (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0)))
wanted = 1;
immediate_quit = 0;
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
int nbytes = len + directory_nbytes + needsep;
int nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
memcpy (SDATA (fullname) + directory_nbytes + needsep,
SDATA (name), len);
nchars = chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
/* Construct an expanded filename for the directory entry.
Use the decoded names for input to Ffile_attributes. */
Lisp_Object decoded_fullname, fileattrs;
struct gcpro gcpro1, gcpro2;
decoded_fullname = fileattrs = Qnil;
GCPRO2 (decoded_fullname, fileattrs);
/* Both Fexpand_file_name and Ffile_attributes can GC. */
decoded_fullname = Fexpand_file_name (name, directory);
fileattrs = Ffile_attributes (decoded_fullname, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
UNGCPRO;
}
else
list = Fcons (finalname, list);
}
UNGCPRO;
}
}
BLOCK_INPUT;
closedir (d);
UNBLOCK_INPUT;
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
#endif
/* Discard the unwind protect. */
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
RETURN_UNGCPRO (list);
}
static time_t
get_boot_time (void)
{
#if defined (BOOT_TIME)
int counter;
#endif
if (boot_time_initialized)
return boot_time;
boot_time_initialized = 1;
#if defined (CTL_KERN) && defined (KERN_BOOTTIME)
{
int mib[2];
size_t size;
struct timeval boottime_val;
mib[0] = CTL_KERN;
mib[1] = KERN_BOOTTIME;
size = sizeof (boottime_val);
if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
{
boot_time = boottime_val.tv_sec;
return boot_time;
}
}
#endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
if (BOOT_TIME_FILE)
{
struct stat st;
if (stat (BOOT_TIME_FILE, &st) == 0)
{
boot_time = st.st_mtime;
return boot_time;
}
}
#if defined (BOOT_TIME)
#ifndef CANNOT_DUMP
/* The utmp routines maintain static state.
Don't touch that state unless we are initialized,
since it might not survive dumping. */
if (! initialized)
return boot_time;
#endif /* not CANNOT_DUMP */
/* Try to get boot time from utmp before wtmp,
since utmp is typically much smaller than wtmp.
Passing a null pointer causes get_boot_time_1
to inspect the default file, namely utmp. */
get_boot_time_1 (0, 0);
if (boot_time)
return boot_time;
/* Try to get boot time from the current wtmp file. */
get_boot_time_1 (WTMP_FILE, 1);
/* If we did not find a boot time in wtmp, look at wtmp, and so on. */
for (counter = 0; counter < 20 && ! boot_time; counter++)
{
char cmd_string[sizeof WTMP_FILE ".19.gz"];
Lisp_Object tempname, filename;
bool delete_flag = 0;
filename = Qnil;
tempname = make_formatted_string
(cmd_string, "%s.%d", WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
filename = tempname;
else
{
tempname = make_formatted_string (cmd_string, "%s.%d.gz",
WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
{
Lisp_Object args[6];
/* The utmp functions on mescaline.gnu.org accept only
file names up to 8 characters long. Choose a 2
character long prefix, and call make_temp_file with
second arg non-zero, so that it will add not more
than 6 characters to the prefix. */
filename = Fexpand_file_name (build_string ("wt"),
Vtemporary_file_directory);
filename = make_temp_name (filename, 1);
args[0] = build_string ("gzip");
args[1] = Qnil;
args[2] = list2 (QCfile, filename);
args[3] = Qnil;
args[4] = build_string ("-cd");
args[5] = tempname;
Fcall_process (6, args);
delete_flag = 1;
}
}
if (! NILP (filename))
{
get_boot_time_1 (SSDATA (filename), 1);
if (delete_flag)
unlink (SSDATA (filename));
}
}
return boot_time;
#else
return 0;
#endif
}