(Fyes_or_no_p): Use Qyes_or_no_p_history.
[emacs.git] / src / filelock.c
blob787fcc3ce66c00c0e3a175580140aabd0aab934c
1 /* Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
3 This file is part of GNU Emacs.
5 GNU Emacs is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2, or (at your option)
8 any later version.
10 GNU Emacs is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with GNU Emacs; see the file COPYING. If not, write to
17 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 #include <sys/types.h>
21 #include <sys/stat.h>
22 #include "config.h"
24 #ifdef VMS
25 #include "vms-pwd.h"
26 #else
27 #include <pwd.h>
28 #endif
30 #include <errno.h>
31 #include <sys/file.h>
32 #ifdef USG
33 #include <fcntl.h>
34 #endif /* USG */
36 #include "lisp.h"
37 #include "paths.h"
38 #include "buffer.h"
40 extern int errno;
42 extern char *egetenv ();
43 extern char *strcpy ();
45 #ifndef __386bsd__
46 extern struct passwd *getpwuid ();
47 #endif
49 #ifdef CLASH_DETECTION
51 /* If system does not have symbolic links, it does not have lstat.
52 In that case, use ordinary stat instead. */
54 #ifndef S_IFLNK
55 #define lstat stat
56 #endif
59 /* The name of the directory in which we keep lock files, with a '/'
60 appended. */
61 char *lock_path;
63 /* The name of the file in the lock directory which is used to
64 arbitrate access to the entire directory. */
65 #define SUPERLOCK_NAME "!!!SuperLock!!!"
67 /* The path to the superlock file. This is SUPERLOCK_NAME appended to
68 lock_path. */
69 char *superlock_path;
71 /* Set LOCK to the name of the lock file for the filename FILE.
72 char *LOCK; Lisp_Object FILE; */
74 #ifndef HAVE_LONG_FILE_NAMES
76 #define MAKE_LOCK_PATH(lock, file) \
77 (lock = (char *) alloca (14 + strlen (lock_path) + 1), \
78 fill_in_lock_short_file_name (lock, (file)))
81 fill_in_lock_short_file_name (lockfile, fn)
82 register char *lockfile;
83 register Lisp_Object fn;
85 register union
87 unsigned int word [2];
88 unsigned char byte [8];
89 } crc;
90 register unsigned char *p, new;
92 /* 7-bytes cyclic code for burst correction on byte-by-byte basis.
93 the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */
95 crc.word[0] = crc.word[1] = 0;
97 for (p = XSTRING (fn)->data; new = *p++; )
99 new += crc.byte[7];
100 crc.byte[7] = crc.byte[6];
101 crc.byte[6] = crc.byte[5] + new;
102 crc.byte[5] = crc.byte[4];
103 crc.byte[4] = crc.byte[3];
104 crc.byte[3] = crc.byte[2] + new;
105 crc.byte[2] = crc.byte[1];
106 crc.byte[1] = crc.byte[0];
107 crc.byte[0] = new;
109 sprintf (lockfile, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_path,
110 crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3],
111 crc.byte[4], crc.byte[5], crc.byte[6]);
114 #else /* defined HAVE_LONG_FILE_NAMES */
116 #define MAKE_LOCK_PATH(lock, file) \
117 (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_path) + 1), \
118 fill_in_lock_file_name (lock, (file)))
121 fill_in_lock_file_name (lockfile, fn)
122 register char *lockfile;
123 register Lisp_Object fn;
125 register char *p;
127 strcpy (lockfile, lock_path);
129 p = lockfile + strlen (lockfile);
131 strcpy (p, XSTRING (fn)->data);
133 for (; *p; p++)
135 if (*p == '/')
136 *p = '!';
139 #endif /* !defined HAVE_LONG_FILE_NAMES */
141 static Lisp_Object
142 lock_file_owner_name (lfname)
143 char *lfname;
145 struct stat s;
146 struct passwd *the_pw;
148 if (lstat (lfname, &s) == 0)
149 the_pw = getpwuid (s.st_uid);
150 return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
154 /* lock_file locks file fn,
155 meaning it serves notice on the world that you intend to edit that file.
156 This should be done only when about to modify a file-visiting
157 buffer previously unmodified.
158 Do not (normally) call lock_buffer for a buffer already modified,
159 as either the file is already locked, or the user has already
160 decided to go ahead without locking.
162 When lock_buffer returns, either the lock is locked for us,
163 or the user has said to go ahead without locking.
165 If the file is locked by someone else, lock_buffer calls
166 ask-user-about-lock (a Lisp function) with two arguments,
167 the file name and the name of the user who did the locking.
168 This function can signal an error, or return t meaning
169 take away the lock, or return nil meaning ignore the lock. */
171 /* The lock file name is the file name with "/" replaced by "!"
172 and put in the Emacs lock directory. */
173 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
175 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
176 representation of a 14-bytes CRC generated from the file name
177 and put in the Emacs lock directory (not very nice, but it works).
178 (ie., /ka/king/junk.tex -> /!/ec92d3ed24a8f0). */
180 void
181 lock_file (fn)
182 register Lisp_Object fn;
184 register Lisp_Object attack;
185 register char *lfname;
187 MAKE_LOCK_PATH (lfname, fn);
189 /* See if this file is visited and has changed on disk since it was
190 visited. */
192 register Lisp_Object subject_buf = Fget_file_buffer (fn);
193 if (!NILP (subject_buf)
194 && NILP (Fverify_visited_file_modtime (subject_buf))
195 && !NILP (Ffile_exists_p (fn)))
196 call1 (intern ("ask-user-about-supersession-threat"), fn);
199 /* Try to lock the lock. */
200 if (lock_if_free (lfname) <= 0)
201 /* Return now if we have locked it, or if lock dir does not exist */
202 return;
204 /* Else consider breaking the lock */
205 attack = call2 (intern ("ask-user-about-lock"), fn,
206 lock_file_owner_name (lfname));
207 if (!NILP (attack))
208 /* User says take the lock */
210 lock_superlock (lfname);
211 lock_file_1 (lfname, O_WRONLY) ;
212 unlink (superlock_path);
213 return;
215 /* User says ignore the lock */
218 /* Lock the lock file named LFNAME.
219 If MODE is O_WRONLY, we do so even if it is already locked.
220 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
221 Return 1 if successful, 0 if not. */
224 lock_file_1 (lfname, mode)
225 int mode; char *lfname;
227 register int fd;
228 char buf[20];
230 if ((fd = open (lfname, mode, 0666)) >= 0)
232 #ifdef USG
233 chmod (lfname, 0666);
234 #else
235 fchmod (fd, 0666);
236 #endif
237 sprintf (buf, "%d ", getpid ());
238 write (fd, buf, strlen (buf));
239 close (fd);
240 return 1;
242 else
243 return 0;
246 /* Lock the lock named LFNAME if possible.
247 Return 0 in that case.
248 Return positive if lock is really locked by someone else.
249 Return -1 if cannot lock for any other reason. */
252 lock_if_free (lfname)
253 register char *lfname;
255 register int clasher;
257 while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
259 if (errno != EEXIST)
260 return -1;
261 clasher = current_lock_owner (lfname);
262 if (clasher != 0)
263 if (clasher != getpid ())
264 return (clasher);
265 else return (0);
266 /* Try again to lock it */
268 return 0;
271 /* Return the pid of the process that claims to own the lock file LFNAME,
272 or 0 if nobody does or the lock is obsolete,
273 or -1 if something is wrong with the locking mechanism. */
276 current_lock_owner (lfname)
277 char *lfname;
279 int owner = current_lock_owner_1 (lfname);
280 if (owner == 0 && errno == ENOENT)
281 return (0);
282 /* Is it locked by a process that exists? */
283 if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
284 return (owner);
285 if (unlink (lfname) < 0)
286 return (-1);
287 return (0);
291 current_lock_owner_1 (lfname)
292 char *lfname;
294 register int fd;
295 char buf[20];
296 int tem;
298 fd = open (lfname, O_RDONLY, 0666);
299 if (fd < 0)
300 return 0;
301 tem = read (fd, buf, sizeof buf);
302 close (fd);
303 return (tem <= 0 ? 0 : atoi (buf));
307 void
308 unlock_file (fn)
309 register Lisp_Object fn;
311 register char *lfname;
313 MAKE_LOCK_PATH (lfname, fn);
315 lock_superlock (lfname);
317 if (current_lock_owner_1 (lfname) == getpid ())
318 unlink (lfname);
320 unlink (superlock_path);
323 lock_superlock (lfname)
324 char *lfname;
326 register int i, fd;
328 for (i = -20; i < 0 && (fd = open (superlock_path,
329 O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
330 i++)
332 if (errno != EEXIST)
333 return;
334 sleep (1);
336 if (fd >= 0)
338 #ifdef USG
339 chmod (superlock_path, 0666);
340 #else
341 fchmod (fd, 0666);
342 #endif
343 write (fd, lfname, strlen (lfname));
344 close (fd);
348 void
349 unlock_all_files ()
351 register Lisp_Object tail;
352 register struct buffer *b;
354 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
355 tail = XCONS (tail)->cdr)
357 b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
358 if (XTYPE (b->filename) == Lisp_String &&
359 b->save_modified < BUF_MODIFF (b))
360 unlock_file (b->filename);
365 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
366 0, 1, 0,
367 "Lock FILE, if current buffer is modified.\n\
368 FILE defaults to current buffer's visited file,\n\
369 or else nothing is done if current buffer isn't visiting a file.")
370 (fn)
371 Lisp_Object fn;
373 if (NILP (fn))
374 fn = current_buffer->filename;
375 else
376 CHECK_STRING (fn, 0);
377 if (current_buffer->save_modified < MODIFF
378 && !NILP (fn))
379 lock_file (fn);
380 return Qnil;
383 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
384 0, 0, 0,
385 "Unlock the file visited in the current buffer,\n\
386 if it should normally be locked.")
389 if (current_buffer->save_modified < MODIFF &&
390 XTYPE (current_buffer->filename) == Lisp_String)
391 unlock_file (current_buffer->filename);
392 return Qnil;
396 /* Unlock the file visited in buffer BUFFER. */
398 unlock_buffer (buffer)
399 struct buffer *buffer;
401 if (buffer->save_modified < BUF_MODIFF (buffer) &&
402 XTYPE (buffer->filename) == Lisp_String)
403 unlock_file (buffer->filename);
406 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
407 "Return nil if the FILENAME is not locked,\n\
408 t if it is locked by you, else a string of the name of the locker.")
409 (fn)
410 Lisp_Object fn;
412 register char *lfname;
413 int owner;
415 fn = Fexpand_file_name (fn, Qnil);
417 MAKE_LOCK_PATH (lfname, fn);
419 owner = current_lock_owner (lfname);
420 if (owner <= 0)
421 return (Qnil);
422 else if (owner == getpid ())
423 return (Qt);
425 return (lock_file_owner_name (lfname));
429 /* Initialization functions. */
431 init_filelock ()
433 lock_path = egetenv ("EMACSLOCKDIR");
434 if (! lock_path)
435 lock_path = PATH_LOCK;
437 /* Make sure it ends with a slash. */
438 if (lock_path[strlen (lock_path) - 1] != '/')
440 lock_path = strcpy ((char *) xmalloc (strlen (lock_path) + 2),
441 lock_path);
442 strcat (lock_path, "/");
445 superlock_path = (char *) xmalloc ((strlen (lock_path)
446 + sizeof (SUPERLOCK_NAME)));
447 strcpy (superlock_path, lock_path);
448 strcat (superlock_path, SUPERLOCK_NAME);
451 syms_of_filelock ()
453 defsubr (&Sunlock_buffer);
454 defsubr (&Slock_buffer);
455 defsubr (&Sfile_locked_p);
458 #endif /* CLASH_DETECTION */