]>
code.delx.au - gnu-emacs/blob - src/filelock.c
1 /* Copyright (C) 1985, 1986, 1987, 1993, 1994 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)
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, Inc., 59 Temple Place - Suite 330,
18 Boston, MA 02111-1307, USA. */
21 #include <sys/types.h>
41 #ifdef SYSV_SYSTEM_DIR
43 #else /* not SYSV_SYSTEM_DIR */
44 #ifdef NONSYSTEM_DIR_LIBRARY
46 #else /* not NONSYSTEM_DIR_LIBRARY */
52 #endif /* not NONSYSTEM_DIR_LIBRARY */
54 extern DIR *opendir ();
55 #endif /* not MSDOS */
56 #endif /* not SYSV_SYSTEM_DIR */
60 extern char *egetenv ();
61 extern char *strcpy ();
63 #ifdef DECLARE_GETPWUID_WITH_UID_T
64 extern struct passwd
*getpwuid (uid_t
);
66 extern struct passwd
*getpwuid ();
69 #ifdef CLASH_DETECTION
71 /* If system does not have symbolic links, it does not have lstat.
72 In that case, use ordinary stat instead. */
79 /* The name of the directory in which we keep lock files, with a '/'
83 /* The name of the file in the lock directory which is used to
84 arbitrate access to the entire directory. */
85 #define SUPERLOCK_NAME "!!!SuperLock!!!"
87 /* The name of the superlock file. This is SUPERLOCK_NAME appended to
91 /* Set LOCK to the name of the lock file for the filename FILE.
92 char *LOCK; Lisp_Object FILE; */
94 #ifndef HAVE_LONG_FILE_NAMES
96 #define MAKE_LOCK_NAME(lock, file) \
97 (lock = (char *) alloca (14 + strlen (lock_dir) + 1), \
98 fill_in_lock_short_file_name (lock, (file)))
101 fill_in_lock_short_file_name (lockfile
, fn
)
102 register char *lockfile
;
103 register Lisp_Object fn
;
107 unsigned int word
[2];
108 unsigned char byte
[8];
110 register unsigned char *p
, new;
112 /* 7-bytes cyclic code for burst correction on byte-by-byte basis.
113 the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */
115 crc
.word
[0] = crc
.word
[1] = 0;
117 for (p
= XSTRING (fn
)->data
; new = *p
++; )
120 crc
.byte
[6] = crc
.byte
[5] + new;
121 crc
.byte
[5] = crc
.byte
[4];
122 crc
.byte
[4] = crc
.byte
[3];
123 crc
.byte
[3] = crc
.byte
[2] + new;
124 crc
.byte
[2] = crc
.byte
[1];
125 crc
.byte
[1] = crc
.byte
[0];
128 sprintf (lockfile
, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_dir
,
129 crc
.byte
[0], crc
.byte
[1], crc
.byte
[2], crc
.byte
[3],
130 crc
.byte
[4], crc
.byte
[5], crc
.byte
[6]);
133 #else /* defined HAVE_LONG_FILE_NAMES */
135 #define MAKE_LOCK_NAME(lock, file) \
136 (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_dir) + 1), \
137 fill_in_lock_file_name (lock, (file)))
140 fill_in_lock_file_name (lockfile
, fn
)
141 register char *lockfile
;
142 register Lisp_Object fn
;
146 strcpy (lockfile
, lock_dir
);
148 p
= lockfile
+ strlen (lockfile
);
150 strcpy (p
, XSTRING (fn
)->data
);
158 #endif /* !defined HAVE_LONG_FILE_NAMES */
161 lock_file_owner_name (lfname
)
165 struct passwd
*the_pw
;
167 if (lstat (lfname
, &s
) == 0)
168 the_pw
= getpwuid (s
.st_uid
);
172 return (the_pw
== 0 ? Qnil
: build_string (the_pw
->pw_name
));
176 /* lock_file locks file fn,
177 meaning it serves notice on the world that you intend to edit that file.
178 This should be done only when about to modify a file-visiting
179 buffer previously unmodified.
180 Do not (normally) call lock_buffer for a buffer already modified,
181 as either the file is already locked, or the user has already
182 decided to go ahead without locking.
184 When lock_buffer returns, either the lock is locked for us,
185 or the user has said to go ahead without locking.
187 If the file is locked by someone else, lock_buffer calls
188 ask-user-about-lock (a Lisp function) with two arguments,
189 the file name and the name of the user who did the locking.
190 This function can signal an error, or return t meaning
191 take away the lock, or return nil meaning ignore the lock. */
193 /* The lock file name is the file name with "/" replaced by "!"
194 and put in the Emacs lock directory. */
195 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
197 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
198 representation of a 14-bytes CRC generated from the file name
199 and put in the Emacs lock directory (not very nice, but it works).
200 (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */
204 register Lisp_Object fn
;
206 register Lisp_Object attack
, orig_fn
;
207 register char *lfname
;
210 fn
= Fexpand_file_name (fn
, Qnil
);
212 MAKE_LOCK_NAME (lfname
, fn
);
214 /* See if this file is visited and has changed on disk since it was
217 register Lisp_Object subject_buf
;
218 subject_buf
= get_truename_buffer (orig_fn
);
219 if (!NILP (subject_buf
)
220 && NILP (Fverify_visited_file_modtime (subject_buf
))
221 && !NILP (Ffile_exists_p (fn
)))
222 call1 (intern ("ask-user-about-supersession-threat"), fn
);
225 /* Try to lock the lock. */
226 if (lock_if_free (lfname
) <= 0)
227 /* Return now if we have locked it, or if lock dir does not exist */
230 /* Else consider breaking the lock */
231 attack
= call2 (intern ("ask-user-about-lock"), fn
,
232 lock_file_owner_name (lfname
));
234 /* User says take the lock */
236 lock_superlock (lfname
);
237 lock_file_1 (lfname
, O_WRONLY
) ;
238 unlink (superlock_file
);
241 /* User says ignore the lock */
244 /* Lock the lock file named LFNAME.
245 If MODE is O_WRONLY, we do so even if it is already locked.
246 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
247 Return 1 if successful, 0 if not. */
250 lock_file_1 (lfname
, mode
)
251 int mode
; char *lfname
;
256 if ((fd
= open (lfname
, mode
, 0666)) >= 0)
259 chmod (lfname
, 0666);
263 sprintf (buf
, "%d ", getpid ());
264 write (fd
, buf
, strlen (buf
));
272 /* Lock the lock named LFNAME if possible.
273 Return 0 in that case.
274 Return positive if lock is really locked by someone else.
275 Return -1 if cannot lock for any other reason. */
278 lock_if_free (lfname
)
279 register char *lfname
;
281 register int clasher
;
283 while (lock_file_1 (lfname
, O_WRONLY
| O_EXCL
| O_CREAT
) == 0)
287 clasher
= current_lock_owner (lfname
);
289 if (clasher
!= getpid ())
292 /* Try again to lock it */
297 /* Return the pid of the process that claims to own the lock file LFNAME,
298 or 0 if nobody does or the lock is obsolete,
299 or -1 if something is wrong with the locking mechanism. */
302 current_lock_owner (lfname
)
305 int owner
= current_lock_owner_1 (lfname
);
306 if (owner
== 0 && errno
== ENOENT
)
308 /* Is it locked by a process that exists? */
309 if (owner
!= 0 && (kill (owner
, 0) >= 0 || errno
== EPERM
))
311 if (unlink (lfname
) < 0)
317 current_lock_owner_1 (lfname
)
324 fd
= open (lfname
, O_RDONLY
, 0666);
327 tem
= read (fd
, buf
, sizeof buf
);
329 return (tem
<= 0 ? 0 : atoi (buf
));
335 register Lisp_Object fn
;
337 register char *lfname
;
339 fn
= Fexpand_file_name (fn
, Qnil
);
341 MAKE_LOCK_NAME (lfname
, fn
);
343 lock_superlock (lfname
);
345 if (current_lock_owner_1 (lfname
) == getpid ())
348 unlink (superlock_file
);
351 lock_superlock (lfname
)
356 struct stat first_stat
, last_stat
;
361 fd
= open (superlock_file
,
362 O_WRONLY
| O_EXCL
| O_CREAT
, 0666);
364 /* If we succeeded in creating the superlock, we win.
365 Fill in our info and return. */
369 chmod (superlock_file
, 0666);
373 write (fd
, lfname
, strlen (lfname
));
378 /* If the problem is not just that it is already locked,
383 message ("Superlock file exists, retrying...");
386 stat (superlock_file
, &first_stat
);
389 stat (superlock_file
, &last_stat
);
391 /* This seems to be necessary to prevent Emacs from hanging when the
392 competing process has already deleted the superlock, but it's still
393 in the NFS cache. So we force NFS to synchronize the cache. */
394 lockdir
= opendir (lock_dir
);
402 if (first_stat
.st_ctime
== last_stat
.st_ctime
)
405 value
= unlink (superlock_file
);
408 message ("Superlock file deleted");
410 message ("Failed to delete superlock file");
413 message ("Giving up on the superlock file");
419 register Lisp_Object tail
;
420 register struct buffer
*b
;
422 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
424 b
= XBUFFER (XCONS (XCONS (tail
)->car
)->cdr
);
425 if (STRINGP (b
->file_truename
) && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
))
426 unlock_file (b
->file_truename
);
431 DEFUN ("lock-buffer", Flock_buffer
, Slock_buffer
,
433 "Lock FILE, if current buffer is modified.\n\
434 FILE defaults to current buffer's visited file,\n\
435 or else nothing is done if current buffer isn't visiting a file.")
440 file
= current_buffer
->file_truename
;
442 CHECK_STRING (file
, 0);
443 if (SAVE_MODIFF
< MODIFF
449 DEFUN ("unlock-buffer", Funlock_buffer
, Sunlock_buffer
,
451 "Unlock the file visited in the current buffer,\n\
452 if it should normally be locked.")
455 if (SAVE_MODIFF
< MODIFF
456 && STRINGP (current_buffer
->file_truename
))
457 unlock_file (current_buffer
->file_truename
);
462 /* Unlock the file visited in buffer BUFFER. */
464 unlock_buffer (buffer
)
465 struct buffer
*buffer
;
467 if (BUF_SAVE_MODIFF (buffer
) < BUF_MODIFF (buffer
)
468 && STRINGP (buffer
->file_truename
))
469 unlock_file (buffer
->file_truename
);
472 DEFUN ("file-locked-p", Ffile_locked_p
, Sfile_locked_p
, 0, 1, 0,
473 "Return nil if the FILENAME is not locked,\n\
474 t if it is locked by you, else a string of the name of the locker.")
476 Lisp_Object filename
;
478 register char *lfname
;
481 filename
= Fexpand_file_name (filename
, Qnil
);
483 MAKE_LOCK_NAME (lfname
, filename
);
485 owner
= current_lock_owner (lfname
);
488 else if (owner
== getpid ())
491 return (lock_file_owner_name (lfname
));
495 /* Initialization functions. */
501 lock_dir
= egetenv ("EMACSLOCKDIR");
503 lock_dir
= PATH_LOCK
;
505 /* Copy the name in case egetenv got it from a Lisp string. */
506 new_name
= (char *) xmalloc (strlen (lock_dir
) + 2);
507 strcpy (new_name
, lock_dir
);
510 /* Make sure it ends with a slash. */
511 if (lock_dir
[strlen (lock_dir
) - 1] != '/')
512 strcat (lock_dir
, "/");
514 superlock_file
= (char *) xmalloc ((strlen (lock_dir
)
515 + sizeof (SUPERLOCK_NAME
)));
516 strcpy (superlock_file
, lock_dir
);
517 strcat (superlock_file
, SUPERLOCK_NAME
);
522 defsubr (&Sunlock_buffer
);
523 defsubr (&Slock_buffer
);
524 defsubr (&Sfile_locked_p
);
527 #endif /* CLASH_DETECTION */