vc-parse-buffer: arrange for old properties to get cleared when their
[emacs.git] / src / filelock.c
blob52349ffa872de9cf39e0e79e53999436d20bdc9e
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 #if defined (__bsdi__) || defined (DECLARE_GETPWUID_WITH_UID_T)
46 extern struct passwd *getpwuid (uid_t);
47 #else
48 extern struct passwd *getpwuid ();
49 #endif
51 #ifdef CLASH_DETECTION
53 /* If system does not have symbolic links, it does not have lstat.
54 In that case, use ordinary stat instead. */
56 #ifndef S_IFLNK
57 #define lstat stat
58 #endif
61 /* The name of the directory in which we keep lock files, with a '/'
62 appended. */
63 char *lock_path;
65 /* The name of the file in the lock directory which is used to
66 arbitrate access to the entire directory. */
67 #define SUPERLOCK_NAME "!!!SuperLock!!!"
69 /* The path to the superlock file. This is SUPERLOCK_NAME appended to
70 lock_path. */
71 char *superlock_path;
73 /* Set LOCK to the name of the lock file for the filename FILE.
74 char *LOCK; Lisp_Object FILE; */
76 #ifndef HAVE_LONG_FILE_NAMES
78 #define MAKE_LOCK_PATH(lock, file) \
79 (lock = (char *) alloca (14 + strlen (lock_path) + 1), \
80 fill_in_lock_short_file_name (lock, (file)))
83 fill_in_lock_short_file_name (lockfile, fn)
84 register char *lockfile;
85 register Lisp_Object fn;
87 register union
89 unsigned int word [2];
90 unsigned char byte [8];
91 } crc;
92 register unsigned char *p, new;
94 /* 7-bytes cyclic code for burst correction on byte-by-byte basis.
95 the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */
97 crc.word[0] = crc.word[1] = 0;
99 for (p = XSTRING (fn)->data; new = *p++; )
101 new += crc.byte[6];
102 crc.byte[6] = crc.byte[5] + new;
103 crc.byte[5] = crc.byte[4];
104 crc.byte[4] = crc.byte[3];
105 crc.byte[3] = crc.byte[2] + new;
106 crc.byte[2] = crc.byte[1];
107 crc.byte[1] = crc.byte[0];
108 crc.byte[0] = new;
110 sprintf (lockfile, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_path,
111 crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3],
112 crc.byte[4], crc.byte[5], crc.byte[6]);
115 #else /* defined HAVE_LONG_FILE_NAMES */
117 #define MAKE_LOCK_PATH(lock, file) \
118 (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_path) + 1), \
119 fill_in_lock_file_name (lock, (file)))
122 fill_in_lock_file_name (lockfile, fn)
123 register char *lockfile;
124 register Lisp_Object fn;
126 register char *p;
128 strcpy (lockfile, lock_path);
130 p = lockfile + strlen (lockfile);
132 strcpy (p, XSTRING (fn)->data);
134 for (; *p; p++)
136 if (*p == '/')
137 *p = '!';
140 #endif /* !defined HAVE_LONG_FILE_NAMES */
142 static Lisp_Object
143 lock_file_owner_name (lfname)
144 char *lfname;
146 struct stat s;
147 struct passwd *the_pw;
149 if (lstat (lfname, &s) == 0)
150 the_pw = getpwuid (s.st_uid);
151 return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
155 /* lock_file locks file fn,
156 meaning it serves notice on the world that you intend to edit that file.
157 This should be done only when about to modify a file-visiting
158 buffer previously unmodified.
159 Do not (normally) call lock_buffer for a buffer already modified,
160 as either the file is already locked, or the user has already
161 decided to go ahead without locking.
163 When lock_buffer returns, either the lock is locked for us,
164 or the user has said to go ahead without locking.
166 If the file is locked by someone else, lock_buffer calls
167 ask-user-about-lock (a Lisp function) with two arguments,
168 the file name and the name of the user who did the locking.
169 This function can signal an error, or return t meaning
170 take away the lock, or return nil meaning ignore the lock. */
172 /* The lock file name is the file name with "/" replaced by "!"
173 and put in the Emacs lock directory. */
174 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
176 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
177 representation of a 14-bytes CRC generated from the file name
178 and put in the Emacs lock directory (not very nice, but it works).
179 (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */
181 void
182 lock_file (fn)
183 register Lisp_Object fn;
185 register Lisp_Object attack;
186 register char *lfname;
188 MAKE_LOCK_PATH (lfname, fn);
190 /* See if this file is visited and has changed on disk since it was
191 visited. */
193 register Lisp_Object subject_buf = Fget_file_buffer (fn);
194 if (!NILP (subject_buf)
195 && NILP (Fverify_visited_file_modtime (subject_buf))
196 && !NILP (Ffile_exists_p (fn)))
197 call1 (intern ("ask-user-about-supersession-threat"), fn);
200 /* Try to lock the lock. */
201 if (lock_if_free (lfname) <= 0)
202 /* Return now if we have locked it, or if lock dir does not exist */
203 return;
205 /* Else consider breaking the lock */
206 attack = call2 (intern ("ask-user-about-lock"), fn,
207 lock_file_owner_name (lfname));
208 if (!NILP (attack))
209 /* User says take the lock */
211 lock_superlock (lfname);
212 lock_file_1 (lfname, O_WRONLY) ;
213 unlink (superlock_path);
214 return;
216 /* User says ignore the lock */
219 /* Lock the lock file named LFNAME.
220 If MODE is O_WRONLY, we do so even if it is already locked.
221 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
222 Return 1 if successful, 0 if not. */
225 lock_file_1 (lfname, mode)
226 int mode; char *lfname;
228 register int fd;
229 char buf[20];
231 if ((fd = open (lfname, mode, 0666)) >= 0)
233 #ifdef USG
234 chmod (lfname, 0666);
235 #else
236 fchmod (fd, 0666);
237 #endif
238 sprintf (buf, "%d ", getpid ());
239 write (fd, buf, strlen (buf));
240 close (fd);
241 return 1;
243 else
244 return 0;
247 /* Lock the lock named LFNAME if possible.
248 Return 0 in that case.
249 Return positive if lock is really locked by someone else.
250 Return -1 if cannot lock for any other reason. */
253 lock_if_free (lfname)
254 register char *lfname;
256 register int clasher;
258 while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
260 if (errno != EEXIST)
261 return -1;
262 clasher = current_lock_owner (lfname);
263 if (clasher != 0)
264 if (clasher != getpid ())
265 return (clasher);
266 else return (0);
267 /* Try again to lock it */
269 return 0;
272 /* Return the pid of the process that claims to own the lock file LFNAME,
273 or 0 if nobody does or the lock is obsolete,
274 or -1 if something is wrong with the locking mechanism. */
277 current_lock_owner (lfname)
278 char *lfname;
280 int owner = current_lock_owner_1 (lfname);
281 if (owner == 0 && errno == ENOENT)
282 return (0);
283 /* Is it locked by a process that exists? */
284 if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
285 return (owner);
286 if (unlink (lfname) < 0)
287 return (-1);
288 return (0);
292 current_lock_owner_1 (lfname)
293 char *lfname;
295 register int fd;
296 char buf[20];
297 int tem;
299 fd = open (lfname, O_RDONLY, 0666);
300 if (fd < 0)
301 return 0;
302 tem = read (fd, buf, sizeof buf);
303 close (fd);
304 return (tem <= 0 ? 0 : atoi (buf));
308 void
309 unlock_file (fn)
310 register Lisp_Object fn;
312 register char *lfname;
314 MAKE_LOCK_PATH (lfname, fn);
316 lock_superlock (lfname);
318 if (current_lock_owner_1 (lfname) == getpid ())
319 unlink (lfname);
321 unlink (superlock_path);
324 lock_superlock (lfname)
325 char *lfname;
327 register int i, fd;
329 for (i = -20; i < 0 && (fd = open (superlock_path,
330 O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
331 i++)
333 if (errno != EEXIST)
334 return;
335 sleep (1);
337 if (fd >= 0)
339 #ifdef USG
340 chmod (superlock_path, 0666);
341 #else
342 fchmod (fd, 0666);
343 #endif
344 write (fd, lfname, strlen (lfname));
345 close (fd);
349 void
350 unlock_all_files ()
352 register Lisp_Object tail;
353 register struct buffer *b;
355 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
356 tail = XCONS (tail)->cdr)
358 b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
359 if (XTYPE (b->filename) == Lisp_String &&
360 b->save_modified < BUF_MODIFF (b))
361 unlock_file (b->filename);
366 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
367 0, 1, 0,
368 "Lock FILE, if current buffer is modified.\n\
369 FILE defaults to current buffer's visited file,\n\
370 or else nothing is done if current buffer isn't visiting a file.")
371 (fn)
372 Lisp_Object fn;
374 if (NILP (fn))
375 fn = current_buffer->filename;
376 else
377 CHECK_STRING (fn, 0);
378 if (current_buffer->save_modified < MODIFF
379 && !NILP (fn))
380 lock_file (fn);
381 return Qnil;
384 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
385 0, 0, 0,
386 "Unlock the file visited in the current buffer,\n\
387 if it should normally be locked.")
390 if (current_buffer->save_modified < MODIFF &&
391 XTYPE (current_buffer->filename) == Lisp_String)
392 unlock_file (current_buffer->filename);
393 return Qnil;
397 /* Unlock the file visited in buffer BUFFER. */
399 unlock_buffer (buffer)
400 struct buffer *buffer;
402 if (buffer->save_modified < BUF_MODIFF (buffer) &&
403 XTYPE (buffer->filename) == Lisp_String)
404 unlock_file (buffer->filename);
407 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
408 "Return nil if the FILENAME is not locked,\n\
409 t if it is locked by you, else a string of the name of the locker.")
410 (fn)
411 Lisp_Object fn;
413 register char *lfname;
414 int owner;
416 fn = Fexpand_file_name (fn, Qnil);
418 MAKE_LOCK_PATH (lfname, fn);
420 owner = current_lock_owner (lfname);
421 if (owner <= 0)
422 return (Qnil);
423 else if (owner == getpid ())
424 return (Qt);
426 return (lock_file_owner_name (lfname));
430 /* Initialization functions. */
432 init_filelock ()
434 lock_path = egetenv ("EMACSLOCKDIR");
435 if (! lock_path)
436 lock_path = PATH_LOCK;
438 /* Make sure it ends with a slash. */
439 if (lock_path[strlen (lock_path) - 1] != '/')
441 char *new_path = (char *) xmalloc (strlen (lock_path) + 2);
442 strcpy (new_path, lock_path);
443 lock_path = new_path;
444 strcat (lock_path, "/");
447 superlock_path = (char *) xmalloc ((strlen (lock_path)
448 + sizeof (SUPERLOCK_NAME)));
449 strcpy (superlock_path, lock_path);
450 strcat (superlock_path, SUPERLOCK_NAME);
453 syms_of_filelock ()
455 defsubr (&Sunlock_buffer);
456 defsubr (&Slock_buffer);
457 defsubr (&Sfile_locked_p);
460 #endif /* CLASH_DETECTION */