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, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 #include <sys/types.h>
40 #ifdef SYSV_SYSTEM_DIR
42 #else /* not SYSV_SYSTEM_DIR */
43 #ifdef NONSYSTEM_DIR_LIBRARY
45 #else /* not NONSYSTEM_DIR_LIBRARY */
51 #endif /* not NONSYSTEM_DIR_LIBRARY */
53 extern DIR *opendir ();
54 #endif /* not MSDOS */
55 #endif /* not SYSV_SYSTEM_DIR */
59 extern char *egetenv ();
60 extern char *strcpy ();
62 #ifdef DECLARE_GETPWUID_WITH_UID_T
63 extern struct passwd
*getpwuid (uid_t
);
65 extern struct passwd
*getpwuid ();
68 #ifdef CLASH_DETECTION
70 /* If system does not have symbolic links, it does not have lstat.
71 In that case, use ordinary stat instead. */
78 /* The name of the directory in which we keep lock files, with a '/'
82 /* The name of the file in the lock directory which is used to
83 arbitrate access to the entire directory. */
84 #define SUPERLOCK_NAME "!!!SuperLock!!!"
86 /* The name of the superlock file. This is SUPERLOCK_NAME appended to
90 /* Set LOCK to the name of the lock file for the filename FILE.
91 char *LOCK; Lisp_Object FILE; */
93 #ifndef HAVE_LONG_FILE_NAMES
95 #define MAKE_LOCK_NAME(lock, file) \
96 (lock = (char *) alloca (14 + strlen (lock_dir) + 1), \
97 fill_in_lock_short_file_name (lock, (file)))
100 fill_in_lock_short_file_name (lockfile
, fn
)
101 register char *lockfile
;
102 register Lisp_Object fn
;
106 unsigned int word
[2];
107 unsigned char byte
[8];
109 register unsigned char *p
, new;
111 /* 7-bytes cyclic code for burst correction on byte-by-byte basis.
112 the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */
114 crc
.word
[0] = crc
.word
[1] = 0;
116 for (p
= XSTRING (fn
)->data
; new = *p
++; )
119 crc
.byte
[6] = crc
.byte
[5] + new;
120 crc
.byte
[5] = crc
.byte
[4];
121 crc
.byte
[4] = crc
.byte
[3];
122 crc
.byte
[3] = crc
.byte
[2] + new;
123 crc
.byte
[2] = crc
.byte
[1];
124 crc
.byte
[1] = crc
.byte
[0];
127 sprintf (lockfile
, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_dir
,
128 crc
.byte
[0], crc
.byte
[1], crc
.byte
[2], crc
.byte
[3],
129 crc
.byte
[4], crc
.byte
[5], crc
.byte
[6]);
132 #else /* defined HAVE_LONG_FILE_NAMES */
134 #define MAKE_LOCK_NAME(lock, file) \
135 (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_dir) + 1), \
136 fill_in_lock_file_name (lock, (file)))
139 fill_in_lock_file_name (lockfile
, fn
)
140 register char *lockfile
;
141 register Lisp_Object fn
;
145 strcpy (lockfile
, lock_dir
);
147 p
= lockfile
+ strlen (lockfile
);
149 strcpy (p
, XSTRING (fn
)->data
);
157 #endif /* !defined HAVE_LONG_FILE_NAMES */
160 lock_file_owner_name (lfname
)
164 struct passwd
*the_pw
;
166 if (lstat (lfname
, &s
) == 0)
167 the_pw
= getpwuid (s
.st_uid
);
168 return (the_pw
== 0 ? Qnil
: build_string (the_pw
->pw_name
));
172 /* lock_file locks file fn,
173 meaning it serves notice on the world that you intend to edit that file.
174 This should be done only when about to modify a file-visiting
175 buffer previously unmodified.
176 Do not (normally) call lock_buffer for a buffer already modified,
177 as either the file is already locked, or the user has already
178 decided to go ahead without locking.
180 When lock_buffer returns, either the lock is locked for us,
181 or the user has said to go ahead without locking.
183 If the file is locked by someone else, lock_buffer calls
184 ask-user-about-lock (a Lisp function) with two arguments,
185 the file name and the name of the user who did the locking.
186 This function can signal an error, or return t meaning
187 take away the lock, or return nil meaning ignore the lock. */
189 /* The lock file name is the file name with "/" replaced by "!"
190 and put in the Emacs lock directory. */
191 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
193 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex
194 representation of a 14-bytes CRC generated from the file name
195 and put in the Emacs lock directory (not very nice, but it works).
196 (ie., /ka/king/junk.tex -> /!/12a82c62f1c6da). */
200 register Lisp_Object fn
;
202 register Lisp_Object attack
;
203 register char *lfname
;
205 MAKE_LOCK_NAME (lfname
, fn
);
207 /* See if this file is visited and has changed on disk since it was
210 register Lisp_Object subject_buf
;
211 subject_buf
= Fget_file_buffer (fn
);
212 if (!NILP (subject_buf
)
213 && NILP (Fverify_visited_file_modtime (subject_buf
))
214 && !NILP (Ffile_exists_p (fn
)))
215 call1 (intern ("ask-user-about-supersession-threat"), fn
);
218 /* Try to lock the lock. */
219 if (lock_if_free (lfname
) <= 0)
220 /* Return now if we have locked it, or if lock dir does not exist */
223 /* Else consider breaking the lock */
224 attack
= call2 (intern ("ask-user-about-lock"), fn
,
225 lock_file_owner_name (lfname
));
227 /* User says take the lock */
229 lock_superlock (lfname
);
230 lock_file_1 (lfname
, O_WRONLY
) ;
231 unlink (superlock_file
);
234 /* User says ignore the lock */
237 /* Lock the lock file named LFNAME.
238 If MODE is O_WRONLY, we do so even if it is already locked.
239 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
240 Return 1 if successful, 0 if not. */
243 lock_file_1 (lfname
, mode
)
244 int mode
; char *lfname
;
249 if ((fd
= open (lfname
, mode
, 0666)) >= 0)
252 chmod (lfname
, 0666);
256 sprintf (buf
, "%d ", getpid ());
257 write (fd
, buf
, strlen (buf
));
265 /* Lock the lock named LFNAME if possible.
266 Return 0 in that case.
267 Return positive if lock is really locked by someone else.
268 Return -1 if cannot lock for any other reason. */
271 lock_if_free (lfname
)
272 register char *lfname
;
274 register int clasher
;
276 while (lock_file_1 (lfname
, O_WRONLY
| O_EXCL
| O_CREAT
) == 0)
280 clasher
= current_lock_owner (lfname
);
282 if (clasher
!= getpid ())
285 /* Try again to lock it */
290 /* Return the pid of the process that claims to own the lock file LFNAME,
291 or 0 if nobody does or the lock is obsolete,
292 or -1 if something is wrong with the locking mechanism. */
295 current_lock_owner (lfname
)
298 int owner
= current_lock_owner_1 (lfname
);
299 if (owner
== 0 && errno
== ENOENT
)
301 /* Is it locked by a process that exists? */
302 if (owner
!= 0 && (kill (owner
, 0) >= 0 || errno
== EPERM
))
304 if (unlink (lfname
) < 0)
310 current_lock_owner_1 (lfname
)
317 fd
= open (lfname
, O_RDONLY
, 0666);
320 tem
= read (fd
, buf
, sizeof buf
);
322 return (tem
<= 0 ? 0 : atoi (buf
));
328 register Lisp_Object fn
;
330 register char *lfname
;
332 MAKE_LOCK_NAME (lfname
, fn
);
334 lock_superlock (lfname
);
336 if (current_lock_owner_1 (lfname
) == getpid ())
339 unlink (superlock_file
);
342 lock_superlock (lfname
)
348 for (i
= -20; i
< 0 && (fd
= open (superlock_file
,
349 O_WRONLY
| O_EXCL
| O_CREAT
, 0666)) < 0;
355 /* This seems to be necessary to prevent Emacs from hanging when the
356 competing process has already deleted the superlock, but it's still
357 in the NFS cache. So we force NFS to synchronize the cache. */
358 if (lockdir
= opendir (lock_dir
))
366 chmod (superlock_file
, 0666);
370 write (fd
, lfname
, strlen (lfname
));
378 register Lisp_Object tail
;
379 register struct buffer
*b
;
381 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
383 b
= XBUFFER (XCONS (XCONS (tail
)->car
)->cdr
);
384 if (STRINGP (b
->filename
) && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
))
385 unlock_file (b
->filename
);
390 DEFUN ("lock-buffer", Flock_buffer
, Slock_buffer
,
392 "Lock FILE, if current buffer is modified.\n\
393 FILE defaults to current buffer's visited file,\n\
394 or else nothing is done if current buffer isn't visiting a file.")
399 fn
= current_buffer
->filename
;
401 CHECK_STRING (fn
, 0);
402 if (SAVE_MODIFF
< MODIFF
408 DEFUN ("unlock-buffer", Funlock_buffer
, Sunlock_buffer
,
410 "Unlock the file visited in the current buffer,\n\
411 if it should normally be locked.")
414 if (SAVE_MODIFF
< MODIFF
415 && STRINGP (current_buffer
->filename
))
416 unlock_file (current_buffer
->filename
);
421 /* Unlock the file visited in buffer BUFFER. */
423 unlock_buffer (buffer
)
424 struct buffer
*buffer
;
426 if (BUF_SAVE_MODIFF (buffer
) < BUF_MODIFF (buffer
)
427 && STRINGP (buffer
->filename
))
428 unlock_file (buffer
->filename
);
431 DEFUN ("file-locked-p", Ffile_locked_p
, Sfile_locked_p
, 0, 1, 0,
432 "Return nil if the FILENAME is not locked,\n\
433 t if it is locked by you, else a string of the name of the locker.")
437 register char *lfname
;
440 fn
= Fexpand_file_name (fn
, Qnil
);
442 MAKE_LOCK_NAME (lfname
, fn
);
444 owner
= current_lock_owner (lfname
);
447 else if (owner
== getpid ())
450 return (lock_file_owner_name (lfname
));
454 /* Initialization functions. */
460 lock_dir
= egetenv ("EMACSLOCKDIR");
462 lock_dir
= PATH_LOCK
;
464 /* Copy the name in case egetenv got it from a Lisp string. */
465 new_name
= (char *) xmalloc (strlen (lock_dir
) + 2);
466 strcpy (new_name
, lock_dir
);
469 /* Make sure it ends with a slash. */
470 if (lock_dir
[strlen (lock_dir
) - 1] != '/')
471 strcat (lock_dir
, "/");
473 superlock_file
= (char *) xmalloc ((strlen (lock_dir
)
474 + sizeof (SUPERLOCK_NAME
)));
475 strcpy (superlock_file
, lock_dir
);
476 strcat (superlock_file
, SUPERLOCK_NAME
);
481 defsubr (&Sunlock_buffer
);
482 defsubr (&Slock_buffer
);
483 defsubr (&Sfile_locked_p
);
486 #endif /* CLASH_DETECTION */