]>
code.delx.au - gnu-emacs/blob - src/filelock.c
1 /* Copyright (C) 1985, 1986, 1987 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 1, 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>
43 #ifdef CLASH_DETECTION
45 /* If system does not have symbolic links, it does not have lstat.
46 In that case, use ordinary stat instead. */
53 lock_file_owner_name (lfname
)
57 struct passwd
*the_pw
;
58 extern struct passwd
*getpwuid ();
60 if (lstat (lfname
, &s
) == 0)
61 the_pw
= getpwuid (s
.st_uid
);
62 return (the_pw
== 0 ? Qnil
: build_string (the_pw
->pw_name
));
66 /* lock_file locks file fn,
67 meaning it serves notice on the world that you intend to edit that file.
68 This should be done only when about to modify a file-visiting
69 buffer previously unmodified.
70 Do not (normally) call lock_buffer for a buffer already modified,
71 as either the file is already locked, or the user has already
72 decided to go ahead without locking.
74 When lock_buffer returns, either the lock is locked for us,
75 or the user has said to go ahead without locking.
77 If the file is locked by someone else, lock_buffer calls
78 ask-user-about-lock (a Lisp function) with two arguments,
79 the file name and the name of the user who did the locking.
80 This function can signal an error, or return t meaning
81 take away the lock, or return nil meaning ignore the lock. */
83 /* The lock file name is the file name with "/" replaced by "!"
84 and put in the Emacs lock directory. */
85 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
89 register Lisp_Object fn
;
91 register Lisp_Object attack
;
92 register char *lfname
;
94 /* Create the name of the lock-file for file fn */
95 lfname
= (char *) alloca (XSTRING (fn
)->size
+ strlen (PATH_LOCK
) + 1);
96 fill_in_lock_file_name (lfname
, fn
);
98 /* See if this file is visited and has changed on disk since it was visited. */
100 register Lisp_Object subject_buf
= Fget_file_buffer (fn
);
101 if (!NULL (subject_buf
)
102 && NULL (Fverify_visited_file_modtime (subject_buf
))
103 && !NULL (Ffile_exists_p (fn
)))
104 call1 (intern ("ask-user-about-supersession-threat"), fn
);
107 /* Try to lock the lock. */
108 if (lock_if_free (lfname
) <= 0)
109 /* Return now if we have locked it, or if lock dir does not exist */
112 /* Else consider breaking the lock */
113 attack
= call2 (intern ("ask-user-about-lock"), fn
,
114 lock_file_owner_name (lfname
));
116 /* User says take the lock */
118 lock_superlock (lfname
);
119 lock_file_1 (lfname
, O_WRONLY
) ;
120 unlink (PATH_SUPERLOCK
);
123 /* User says ignore the lock */
126 fill_in_lock_file_name (lockfile
, fn
)
127 register char *lockfile
;
128 register Lisp_Object fn
;
132 strcpy (lockfile
, PATH_LOCK
);
134 p
= lockfile
+ strlen (lockfile
);
136 strcpy (p
, XSTRING (fn
)->data
);
145 /* Lock the lock file named LFNAME.
146 If MODE is O_WRONLY, we do so even if it is already locked.
147 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
148 Return 1 if successful, 0 if not. */
151 lock_file_1 (lfname
, mode
)
152 int mode
; char *lfname
;
157 if ((fd
= open (lfname
, mode
, 0666)) >= 0)
160 chmod (lfname
, 0666);
164 sprintf (buf
, "%d ", getpid ());
165 write (fd
, buf
, strlen (buf
));
173 /* Lock the lock named LFNAME if possible.
174 Return 0 in that case.
175 Return positive if lock is really locked by someone else.
176 Return -1 if cannot lock for any other reason. */
179 lock_if_free (lfname
)
180 register char *lfname
;
182 register int clasher
;
184 while (lock_file_1 (lfname
, O_WRONLY
| O_EXCL
| O_CREAT
) == 0)
188 clasher
= current_lock_owner (lfname
);
190 if (clasher
!= getpid ())
193 /* Try again to lock it */
198 /* Return the pid of the process that claims to own the lock file LFNAME,
199 or 0 if nobody does or the lock is obsolete,
200 or -1 if something is wrong with the locking mechanism. */
203 current_lock_owner (lfname
)
206 int owner
= current_lock_owner_1 (lfname
);
207 if (owner
== 0 && errno
== ENOENT
)
209 /* Is it locked by a process that exists? */
210 if (owner
!= 0 && (kill (owner
, 0) >= 0 || errno
== EPERM
))
212 if (unlink (lfname
) < 0)
218 current_lock_owner_1 (lfname
)
225 fd
= open (lfname
, O_RDONLY
, 0666);
228 tem
= read (fd
, buf
, sizeof buf
);
230 return (tem
<= 0 ? 0 : atoi (buf
));
236 register Lisp_Object fn
;
238 register char *lfname
;
240 lfname
= (char *) alloca (XSTRING (fn
)->size
+ strlen (PATH_LOCK
) + 1);
241 fill_in_lock_file_name (lfname
, fn
);
243 lock_superlock (lfname
);
245 if (current_lock_owner_1 (lfname
) == getpid ())
248 unlink (PATH_SUPERLOCK
);
251 lock_superlock (lfname
)
256 for (i
= -20; i
< 0 && (fd
= open (PATH_SUPERLOCK
,
257 O_WRONLY
| O_EXCL
| O_CREAT
, 0666)) < 0;
267 chmod (PATH_SUPERLOCK
, 0666);
271 write (fd
, lfname
, strlen (lfname
));
279 register Lisp_Object tail
;
280 register struct buffer
*b
;
282 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
283 tail
= XCONS (tail
)->cdr
)
285 b
= XBUFFER (XCONS (XCONS (tail
)->car
)->cdr
);
286 if (XTYPE (b
->filename
) == Lisp_String
&&
287 b
->save_modified
< BUF_MODIFF (b
))
288 unlock_file (b
->filename
);
293 DEFUN ("lock-buffer", Flock_buffer
, Slock_buffer
,
295 "Lock FILE, if current buffer is modified.\n\
296 FILE defaults to current buffer's visited file,\n\
297 or else nothing is done if current buffer isn't visiting a file.")
302 fn
= current_buffer
->filename
;
304 CHECK_STRING (fn
, 0);
305 if (current_buffer
->save_modified
< MODIFF
311 DEFUN ("unlock-buffer", Funlock_buffer
, Sunlock_buffer
,
313 "Unlock the file visited in the current buffer,\n\
314 if it should normally be locked.")
317 if (current_buffer
->save_modified
< MODIFF
&&
318 XTYPE (current_buffer
->filename
) == Lisp_String
)
319 unlock_file (current_buffer
->filename
);
324 /* Unlock the file visited in buffer BUFFER. */
326 unlock_buffer (buffer
)
327 struct buffer
*buffer
;
329 if (buffer
->save_modified
< BUF_MODIFF (buffer
) &&
330 XTYPE (buffer
->filename
) == Lisp_String
)
331 unlock_file (buffer
->filename
);
334 DEFUN ("file-locked-p", Ffile_locked_p
, Sfile_locked_p
, 0, 1, 0,
335 "Return nil if the FILENAME is not locked,\n\
336 t if it is locked by you, else a string of the name of the locker.")
340 register char *lfname
;
343 fn
= Fexpand_file_name (fn
, Qnil
);
345 /* Create the name of the lock-file for file filename */
346 lfname
= (char *) alloca (XSTRING (fn
)->size
+ strlen (PATH_LOCK
) + 1);
347 fill_in_lock_file_name (lfname
, fn
);
349 owner
= current_lock_owner (lfname
);
352 else if (owner
== getpid ())
355 return (lock_file_owner_name (lfname
));
360 defsubr (&Sunlock_buffer
);
361 defsubr (&Slock_buffer
);
362 defsubr (&Sfile_locked_p
);
365 #endif /* CLASH_DETECTION */