|
|
1.1 root 1: /* Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
2:
3: This file is part of GNU Emacs.
4:
5: GNU Emacs is distributed in the hope that it will be useful,
6: but WITHOUT ANY WARRANTY. No author or distributor
7: accepts responsibility to anyone for the consequences of using it
8: or for whether it serves any particular purpose or works at all,
9: unless he says so in writing. Refer to the GNU Emacs General Public
10: License for full details.
11:
12: Everyone is granted permission to copy, modify and redistribute
13: GNU Emacs, but only under the conditions described in the
14: GNU Emacs General Public License. A copy of this license is
15: supposed to have been given to you along with GNU Emacs so you
16: can know your rights and responsibilities. It should be in a
17: file named COPYING. Among other things, the copyright notice
18: and this notice must be preserved on all copies. */
19:
20:
21: #include <sys/types.h>
22: #include <sys/stat.h>
23: #include "config.h"
24: #include "lisp.h"
25: #include "paths.h"
26: #include "buffer.h"
27: #include <pwd.h>
28: #include <errno.h>
29: #include <sys/file.h>
30: #ifdef USG
31: #include <fcntl.h>
32: #endif /* USG */
33:
34: extern int errno;
35:
36: #ifdef CLASH_DETECTION
37:
38: /* If system does not have symbolic links, it does not have lstat.
39: In that case, use ordinary stat instead. */
40:
41: #ifndef S_IFLNK
42: #define lstat stat
43: #endif
44:
45: static Lisp_Object
46: lock_file_owner_name (lfname)
47: {
48: struct stat s;
49: struct passwd *the_pw;
50: extern struct passwd *getpwuid ();
51:
52: if (lstat (lfname, &s) == 0)
53: the_pw = getpwuid (s.st_uid);
54: return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name));
55: }
56:
57:
58: /* lock_file locks file fn,
59: meaning it serves notice on the world that you intend to edit that file.
60: This should be done only when about to modify a file-visiting
61: buffer previously unmodified.
62: Do not (normally) call lock_buffer for a buffer already modified,
63: as either the file is already locked, or the user has already
64: decided to go ahead without locking.
65:
66: When lock_buffer returns, either the lock is locked for us,
67: or the user has said to go ahead without locking.
68:
69: If the file is locked by someone else, lock_buffer calls
70: ask-user-about-lock (a Lisp function) with two arguments,
71: the file name and the name of the user who did the locking.
72: This function can signal an error, or return t meaning
73: take away the lock, or return nil meaning ignore the lock. */
74:
75: /* The lock file name is the file name with "/" replaced by "!"
76: and put in the Emacs lock directory. */
77: /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */
78:
79: void
80: lock_file (fn)
81: register Lisp_Object fn;
82: {
83: register Lisp_Object attack;
84: register char *lfname;
85:
86: /* Create the name of the lock-file for file fn */
87: lfname = (char *) alloca (XSTRING (fn)->size + strlen (PATH_LOCK) + 1);
88: fill_in_lock_file_name (lfname, fn);
89:
90: /* See if this file is visited and has changed on disk since it was visited. */
91: {
92: register Lisp_Object subject_buf = Fget_file_buffer (fn);
93: if (!NULL (subject_buf)
94: && NULL (Fverify_visited_file_modtime (subject_buf))
95: && !NULL (Ffile_exists_p (fn)))
96: call1 (intern ("ask-user-about-supersession-threat"), fn);
97: }
98:
99: /* Try to lock the lock. */
100: if (lock_if_free (lfname) <= 0)
101: /* Return now if we have locked it, or if lock dir does not exist */
102: return;
103:
104: /* Else consider breaking the lock */
105: attack = call2 (intern ("ask-user-about-lock"), fn,
106: lock_file_owner_name (lfname));
107: if (!NULL (attack))
108: /* User says take the lock */
109: {
110: lock_superlock (lfname);
111: lock_file_1 (lfname, O_WRONLY) ;
112: unlink (PATH_SUPERLOCK);
113: return;
114: }
115: /* User says ignore the lock */
116: }
117:
118: fill_in_lock_file_name (lockfile, fn)
119: register char *lockfile;
120: register Lisp_Object fn;
121: {
122: register char *p;
123:
124: strcpy (lockfile, PATH_LOCK);
125:
126: p = lockfile + strlen (lockfile);
127:
128: strcpy (p, XSTRING (fn)->data);
129:
130: for (; *p; p++)
131: {
132: if (*p == '/')
133: *p = '!';
134: }
135: }
136:
137: /* Lock the lock file named LFNAME.
138: If MODE is O_WRONLY, we do so even if it is already locked.
139: If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free.
140: Return 1 if successful, 0 if not. */
141:
142: int
143: lock_file_1 (lfname, mode)
144: int mode; char *lfname;
145: {
146: register int fd;
147: char buf[20];
148:
149: if ((fd = open (lfname, mode, 0666)) >= 0)
150: {
151: fchmod (fd, 0666);
152: sprintf (buf, "%d ", getpid ());
153: write (fd, buf, strlen (buf));
154: close (fd);
155: return 1;
156: }
157: else
158: return 0;
159: }
160:
161: /* Lock the lock named LFNAME if possible.
162: Return 0 in that case.
163: Return positive if lock is really locked by someone else.
164: Return -1 if cannot lock for any other reason. */
165:
166: int
167: lock_if_free (lfname)
168: register char *lfname;
169: {
170: register int clasher;
171:
172: while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0)
173: {
174: if (errno != EEXIST)
175: return -1;
176: clasher = current_lock_owner (lfname);
177: if (clasher != 0)
178: if (clasher != getpid ())
179: return (clasher);
180: else return (0);
181: /* Try again to lock it */
182: }
183: return 0;
184: }
185:
186: /* Return the pid of the process that claims to own the lock file LFNAME,
187: or 0 if nobody does or the lock is obsolete,
188: or -1 if something is wrong with the locking mechanism. */
189:
190: int
191: current_lock_owner (lfname)
192: char *lfname;
193: {
194: int owner = current_lock_owner_1 (lfname);
195: if (owner == 0 && errno == ENOENT)
196: return (0);
197: /* Is it locked by a process that exists? */
198: if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM))
199: return (owner);
200: if (unlink (lfname) < 0)
201: return (-1);
202: return (0);
203: }
204:
205: int
206: current_lock_owner_1 (lfname)
207: char *lfname;
208: {
209: register int fd;
210: char buf[20];
211: int tem;
212:
213: fd = open (lfname, O_RDONLY, 0666);
214: if (fd < 0)
215: return 0;
216: tem = read (fd, buf, sizeof buf);
217: close (fd);
218: return (tem <= 0 ? 0 : atoi (buf));
219: }
220:
221:
222: void
223: unlock_file (fn)
224: register Lisp_Object fn;
225: {
226: register char *lfname;
227:
228: lfname = (char *) alloca (XSTRING (fn)->size + strlen (PATH_LOCK) + 1);
229: fill_in_lock_file_name (lfname, fn);
230:
231: lock_superlock (lfname);
232:
233: if (current_lock_owner_1 (lfname) == getpid ())
234: unlink (lfname);
235:
236: unlink (PATH_SUPERLOCK);
237: }
238:
239: lock_superlock (lfname)
240: char *lfname;
241: {
242: register int i, fd;
243:
244: for (i = -20; i < 0 && (fd = open (PATH_SUPERLOCK,
245: O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0;
246: i++)
247: {
248: if (errno != EEXIST)
249: return;
250: sleep (1);
251: }
252: if (fd >= 0)
253: {
254: fchmod (fd, 0666);
255: write (fd, lfname, strlen (lfname));
256: close (fd);
257: }
258: }
259:
260: void
261: unlock_all_files ()
262: {
263: register Lisp_Object tail;
264: register struct buffer *b;
265:
266: for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
267: tail = XCONS (tail)->cdr)
268: {
269: b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
270: if (XTYPE (b->filename) == Lisp_String &&
271: b->save_modified < b->text.modified)
272: unlock_file (b->filename);
273: }
274: }
275:
276:
277: DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
278: 0, 1, 0,
279: "Locks FILE, if current buffer is modified.\n\
280: FILE defaults to current buffer's visited file,\n\
281: or else nothing is done if current buffer isn't visiting a file.")
282: (fn)
283: Lisp_Object fn;
284: {
285: if (NULL (fn))
286: fn = bf_cur->filename;
287: else
288: CHECK_STRING (fn, 0);
289: if (bf_cur->save_modified < bf_modified
290: && !NULL (fn))
291: lock_file (fn);
292: return Qnil;
293: }
294:
295: DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
296: 0, 0, 0,
297: "Unlocks the file visited in the current buffer,\n\
298: if it should normally be locked.")
299: ()
300: {
301: if (bf_cur->save_modified < bf_modified &&
302: XTYPE (bf_cur->filename) == Lisp_String)
303: unlock_file (bf_cur->filename);
304: return Qnil;
305: }
306:
307:
308: /* Unlock the file visited in buffer BUFFER. */
309:
310: unlock_buffer (buffer)
311: struct buffer *buffer;
312: {
313: bf_cur->text.modified = bf_modified;
314: if (buffer->save_modified < buffer->text.modified &&
315: XTYPE (buffer->filename) == Lisp_String)
316: unlock_file (buffer->filename);
317: }
318:
319: DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
320: "Returns nil if the FILENAME is not locked,\n\
321: t if it is locked by you, else a string of the name of the locker.")
322: (fn)
323: Lisp_Object fn;
324: {
325: register char *lfname;
326: int owner;
327:
328: fn = Fexpand_file_name (fn, Qnil);
329:
330: /* Create the name of the lock-file for file filename */
331: lfname = (char *) alloca (XSTRING (fn)->size + strlen (PATH_LOCK) + 1);
332: fill_in_lock_file_name (lfname, fn);
333:
334: owner = current_lock_owner (lfname);
335: if (owner <= 0)
336: return (Qnil);
337: else if (owner == getpid ())
338: return (Qt);
339:
340: return (lock_file_owner_name (lfname));
341: }
342:
343: syms_of_filelock ()
344: {
345: defsubr (&Sunlock_buffer);
346: defsubr (&Slock_buffer);
347: defsubr (&Sfile_locked_p);
348: }
349:
350: #endif /* CLASH_DETECTION */
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.