]>
code.delx.au - gnu-emacs/blob - src/filelock.c
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)
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>
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
);
48 extern struct passwd
*getpwuid ();
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. */
61 /* The name of the directory in which we keep lock files, with a '/'
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
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
;
89 unsigned int word
[2];
90 unsigned char byte
[8];
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
++; )
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];
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
;
128 strcpy (lockfile
, lock_path
);
130 p
= lockfile
+ strlen (lockfile
);
132 strcpy (p
, XSTRING (fn
)->data
);
140 #endif /* !defined HAVE_LONG_FILE_NAMES */
143 lock_file_owner_name (lfname
)
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). */
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
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 */
205 /* Else consider breaking the lock */
206 attack
= call2 (intern ("ask-user-about-lock"), fn
,
207 lock_file_owner_name (lfname
));
209 /* User says take the lock */
211 lock_superlock (lfname
);
212 lock_file_1 (lfname
, O_WRONLY
) ;
213 unlink (superlock_path
);
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
;
231 if ((fd
= open (lfname
, mode
, 0666)) >= 0)
234 chmod (lfname
, 0666);
238 sprintf (buf
, "%d ", getpid ());
239 write (fd
, buf
, strlen (buf
));
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)
262 clasher
= current_lock_owner (lfname
);
264 if (clasher
!= getpid ())
267 /* Try again to lock it */
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
)
280 int owner
= current_lock_owner_1 (lfname
);
281 if (owner
== 0 && errno
== ENOENT
)
283 /* Is it locked by a process that exists? */
284 if (owner
!= 0 && (kill (owner
, 0) >= 0 || errno
== EPERM
))
286 if (unlink (lfname
) < 0)
292 current_lock_owner_1 (lfname
)
299 fd
= open (lfname
, O_RDONLY
, 0666);
302 tem
= read (fd
, buf
, sizeof buf
);
304 return (tem
<= 0 ? 0 : atoi (buf
));
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 ())
321 unlink (superlock_path
);
324 lock_superlock (lfname
)
329 for (i
= -20; i
< 0 && (fd
= open (superlock_path
,
330 O_WRONLY
| O_EXCL
| O_CREAT
, 0666)) < 0;
340 chmod (superlock_path
, 0666);
344 write (fd
, lfname
, strlen (lfname
));
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
,
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.")
375 fn
= current_buffer
->filename
;
377 CHECK_STRING (fn
, 0);
378 if (current_buffer
->save_modified
< MODIFF
384 DEFUN ("unlock-buffer", Funlock_buffer
, Sunlock_buffer
,
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
);
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.")
413 register char *lfname
;
416 fn
= Fexpand_file_name (fn
, Qnil
);
418 MAKE_LOCK_PATH (lfname
, fn
);
420 owner
= current_lock_owner (lfname
);
423 else if (owner
== getpid ())
426 return (lock_file_owner_name (lfname
));
430 /* Initialization functions. */
434 lock_path
= egetenv ("EMACSLOCKDIR");
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
);
455 defsubr (&Sunlock_buffer
);
456 defsubr (&Slock_buffer
);
457 defsubr (&Sfile_locked_p
);
460 #endif /* CLASH_DETECTION */