I started to clean this up and make it work under System V, until I hit a wall.
[emacs.git] / src / filelock.c
blob738cb382b982afa83418d0f73dbd7c2f6143f5e1
1 /* Copyright (C) 1985, 1986, 1987, 1992 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 #ifdef CLASH_DETECTION
47 /* If system does not have symbolic links, it does not have lstat.
48 In that case, use ordinary stat instead. */
50 #ifndef S_IFLNK
51 #define lstat stat
52 #endif
55 /* The name of the directory in which we keep lock files, with a '/'
56 appended. */
57 char *lock_path;
59 /* The name of the file in the lock directory which is used to
60 arbitrate access to the entire directory. */
61 #define SUPERLOCK_NAME "!!!SuperLock!!!"
63 /* The path to the superlock file. This is SUPERLOCK_NAME appended to
64 lock_path. */
65 char *superlock_path;
67 /* Set LOCK to the name of the lock file for the filename FILE.
68 char *LOCK; Lisp_Object FILE; */
69 #define MAKE_LOCK_PATH(lock, file) \
70 (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_path) + 1), \
71 fill_in_lock_file_name (lock, (file)))
73 fill_in_lock_file_name (lockfile, fn)
74 register char *lockfile;
75 register Lisp_Object fn;
77 register char *p;
79 strcpy (lockfile, lock_path);
81 p = lockfile + strlen (lockfile);
83 strcpy (p, XSTRING (fn)->data);
85 for (; *p; p++)
87 if (*p == '/')
88 *p = '!';
92 static Lisp_Object
93 lock_file_owner_name (lfname)
94 char *lfname;
96 struct stat s;
97 struct passwd *the_pw;
98 extern struct passwd *getpwuid ();
100 if (lstat (lfname, &s) == 0)
101 the_pw = getpwuid (s.st_uid);
102 return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
106 /* lock_file locks file fn,
107 meaning it serves notice on the world that you intend to edit that file.
108 This should be done only when about to modify a file-visiting
109 buffer previously unmodified.
110 Do not (normally) call lock_buffer for a buffer already modified,
111 as either the file is already locked, or the user has already
112 decided to go ahead without locking.
114 When lock_buffer returns, either the lock is locked for us,
115 or the user has said to go ahead without locking.
117 If the file is locked by someone else, lock_buffer calls
118 ask-user-about-lock (a Lisp function) with two arguments,
119 the file name and the name of the user who did the locking.
120 This function can signal an error, or return t meaning
121 take away the lock, or return nil meaning ignore the lock. */
123 /* The lock file name is the file name with "/" replaced by "!"
124 and put in the Emacs lock directory. */
125 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
127 void
128 lock_file (fn)
129 register Lisp_Object fn;
131 register Lisp_Object attack;
132 register char *lfname;
134 MAKE_LOCK_PATH (lfname, fn);
136 /* See if this file is visited and has changed on disk since it was
137 visited. */
139 register Lisp_Object subject_buf = Fget_file_buffer (fn);
140 if (!NILP (subject_buf)
141 && NILP (Fverify_visited_file_modtime (subject_buf))
142 && !NILP (Ffile_exists_p (fn)))
143 call1 (intern ("ask-user-about-supersession-threat"), fn);
146 /* Try to lock the lock. */
147 if (lock_if_free (lfname) <= 0)
148 /* Return now if we have locked it, or if lock dir does not exist */
149 return;
151 /* Else consider breaking the lock */
152 attack = call2 (intern ("ask-user-about-lock"), fn,
153 lock_file_owner_name (lfname));
154 if (!NILP (attack))
155 /* User says take the lock */
157 lock_superlock (lfname);
158 lock_file_1 (lfname, O_WRONLY) ;
159 unlink (superlock_path);
160 return;
162 /* User says ignore the lock */
165 /* Lock the lock file named LFNAME.
166 If MODE is O_WRONLY, we do so even if it is already locked.
167 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
168 Return 1 if successful, 0 if not. */
171 lock_file_1 (lfname, mode)
172 int mode; char *lfname;
174 register int fd;
175 char buf[20];
177 if ((fd = open (lfname, mode, 0666)) >= 0)
179 #ifdef USG
180 chmod (lfname, 0666);
181 #else
182 fchmod (fd, 0666);
183 #endif
184 sprintf (buf, "%d ", getpid ());
185 write (fd, buf, strlen (buf));
186 close (fd);
187 return 1;
189 else
190 return 0;
193 /* Lock the lock named LFNAME if possible.
194 Return 0 in that case.
195 Return positive if lock is really locked by someone else.
196 Return -1 if cannot lock for any other reason. */
199 lock_if_free (lfname)
200 register char *lfname;
202 register int clasher;
204 while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
206 if (errno != EEXIST)
207 return -1;
208 clasher = current_lock_owner (lfname);
209 if (clasher != 0)
210 if (clasher != getpid ())
211 return (clasher);
212 else return (0);
213 /* Try again to lock it */
215 return 0;
218 /* Return the pid of the process that claims to own the lock file LFNAME,
219 or 0 if nobody does or the lock is obsolete,
220 or -1 if something is wrong with the locking mechanism. */
223 current_lock_owner (lfname)
224 char *lfname;
226 int owner = current_lock_owner_1 (lfname);
227 if (owner == 0 && errno == ENOENT)
228 return (0);
229 /* Is it locked by a process that exists? */
230 if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
231 return (owner);
232 if (unlink (lfname) < 0)
233 return (-1);
234 return (0);
238 current_lock_owner_1 (lfname)
239 char *lfname;
241 register int fd;
242 char buf[20];
243 int tem;
245 fd = open (lfname, O_RDONLY, 0666);
246 if (fd < 0)
247 return 0;
248 tem = read (fd, buf, sizeof buf);
249 close (fd);
250 return (tem <= 0 ? 0 : atoi (buf));
254 void
255 unlock_file (fn)
256 register Lisp_Object fn;
258 register char *lfname;
260 MAKE_LOCK_PATH (lfname, fn);
262 lock_superlock (lfname);
264 if (current_lock_owner_1 (lfname) == getpid ())
265 unlink (lfname);
267 unlink (superlock_path);
270 lock_superlock (lfname)
271 char *lfname;
273 register int i, fd;
275 for (i = -20; i < 0 && (fd = open (superlock_path,
276 O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
277 i++)
279 if (errno != EEXIST)
280 return;
281 sleep (1);
283 if (fd >= 0)
285 #ifdef USG
286 chmod (superlock_path, 0666);
287 #else
288 fchmod (fd, 0666);
289 #endif
290 write (fd, lfname, strlen (lfname));
291 close (fd);
295 void
296 unlock_all_files ()
298 register Lisp_Object tail;
299 register struct buffer *b;
301 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
302 tail = XCONS (tail)->cdr)
304 b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
305 if (XTYPE (b->filename) == Lisp_String &&
306 b->save_modified < BUF_MODIFF (b))
307 unlock_file (b->filename);
312 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
313 0, 1, 0,
314 "Lock FILE, if current buffer is modified.\n\
315 FILE defaults to current buffer's visited file,\n\
316 or else nothing is done if current buffer isn't visiting a file.")
317 (fn)
318 Lisp_Object fn;
320 if (NILP (fn))
321 fn = current_buffer->filename;
322 else
323 CHECK_STRING (fn, 0);
324 if (current_buffer->save_modified < MODIFF
325 && !NILP (fn))
326 lock_file (fn);
327 return Qnil;
330 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
331 0, 0, 0,
332 "Unlock the file visited in the current buffer,\n\
333 if it should normally be locked.")
336 if (current_buffer->save_modified < MODIFF &&
337 XTYPE (current_buffer->filename) == Lisp_String)
338 unlock_file (current_buffer->filename);
339 return Qnil;
343 /* Unlock the file visited in buffer BUFFER. */
345 unlock_buffer (buffer)
346 struct buffer *buffer;
348 if (buffer->save_modified < BUF_MODIFF (buffer) &&
349 XTYPE (buffer->filename) == Lisp_String)
350 unlock_file (buffer->filename);
353 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
354 "Return nil if the FILENAME is not locked,\n\
355 t if it is locked by you, else a string of the name of the locker.")
356 (fn)
357 Lisp_Object fn;
359 register char *lfname;
360 int owner;
362 fn = Fexpand_file_name (fn, Qnil);
364 MAKE_LOCK_PATH (lfname, fn);
366 owner = current_lock_owner (lfname);
367 if (owner <= 0)
368 return (Qnil);
369 else if (owner == getpid ())
370 return (Qt);
372 return (lock_file_owner_name (lfname));
376 /* Initialization functions. */
378 init_filelock ()
380 lock_path = egetenv ("EMACSLOCKDIR");
381 if (! lock_path)
382 lock_path = PATH_LOCK;
384 /* Make sure it ends with a slash. */
385 if (lock_path[strlen (lock_path) - 1] != '/')
387 lock_path = strcpy ((char *) xmalloc (strlen (lock_path) + 2),
388 lock_path);
389 strcat (lock_path, "/");
392 superlock_path = (char *) xmalloc ((strlen (lock_path)
393 + sizeof (SUPERLOCK_NAME)));
394 strcpy (superlock_path, lock_path);
395 strcat (superlock_path, SUPERLOCK_NAME);
398 syms_of_filelock ()
400 defsubr (&Sunlock_buffer);
401 defsubr (&Slock_buffer);
402 defsubr (&Sfile_locked_p);
405 #endif /* CLASH_DETECTION */