annotate src/filelock.c @ 854:1d8fb2eee1bb

[xemacs-hg @ 2002-05-28 16:06:58 by didierv] Fix header inclusion order
author didierv
date Tue, 28 May 2002 16:07:03 +0000
parents e7ee5f8bde58
children 84762348c6f9
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
2 Copyright (C) 2001 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
4 This file is part of XEmacs.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
11 XEmacs is distributed in the hope that it will be useful,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 GNU General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 /* Synced with FSF 20.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include <paths.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "sysdir.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "syspwd.h"
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 851
diff changeset
32 #include "syssignal.h" /* for kill. Always include before sysproc.h
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 851
diff changeset
33 -- didier */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
34 #include "sysproc.h" /* for qxe_getpid() */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 Lisp_Object Qask_user_about_supersession_threat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 Lisp_Object Qask_user_about_lock;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
38 int inhibit_clash_detection;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #ifdef CLASH_DETECTION
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
41
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 directory, with link data `user@host.pid'. This avoids a single
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 mount (== failure) point for lock files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 When the host in the lock data is the current host, we can check if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 the pid is valid with kill.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
48
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 Otherwise, we could look at a separate file that maps hostnames to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 reboot times to see if the remote pid can possibly be valid, since we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 don't want Emacs to have to communicate via pipes or sockets or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 whatever to other processes, either locally or remotely; rms says
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 that's too unreliable. Hence the separate file, which could
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 theoretically be updated by daemons running separately -- but this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 whole idea is unimplemented; in practice, at least in our
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 environment, it seems such stale locks arise fairly infrequently, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Emacs' standard methods of dealing with clashes suffice.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 We use symlinks instead of normal files because (1) they can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 stored more efficiently on the filesystem, since the kernel knows
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 they will be small, and (2) all the info about the lock can be read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 in a single system call (readlink). Although we could use regular
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 files to be useful on old systems lacking symlinks, nowadays
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 virtually all such systems are probably single-user anyway, so it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 didn't seem worth the complication.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Similarly, we don't worry about a possible 14-character limit on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 file names, because those are all the same systems that don't have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 symlinks.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
70
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 This is compatible with the locking scheme used by Interleaf (which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 has contributed this implementation for Emacs), and was designed by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 Ethan Jacobson, Kimbo Mundy, and others.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
74
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 --karl@cs.umb.edu/karl@hq.ileaf.com. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 /* Here is the structure that stores information about a lock. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
82 Intbyte *user;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
83 Intbyte *host;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 613
diff changeset
84 pid_t pid;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 } lock_info_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 /* When we read the info back, we might need this much more,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 enough for decimal representation plus null. */
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 613
diff changeset
89 #define LOCK_PID_MAX (4 * sizeof (pid_t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 /* Free the two dynamically-allocated pieces in PTR. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 #define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 /* Write the name of the lock file for FN into LFNAME. Length will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 that of FN plus two more for the leading `.#' plus one for the null. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 #define MAKE_LOCK_NAME(lock, file) \
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 793
diff changeset
97 (lock = (Intbyte *) ALLOCA (XSTRING_LENGTH (file) + 2 + 1), \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
98 fill_in_lock_file_name (lock, file))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 static void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
101 fill_in_lock_file_name (Intbyte *lockfile, Lisp_Object fn)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
103 Intbyte *file_name = XSTRING_DATA (fn);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
104 Intbyte *p;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 613
diff changeset
105 Bytecount dirlen;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
107 for (p = file_name + XSTRING_LENGTH (fn) - 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
108 p > file_name && !IS_ANY_SEP (p[-1]);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
109 p--)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
110 ;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
111 dirlen = p - file_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
113 memcpy (lockfile, file_name, dirlen);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
114 p = lockfile + dirlen;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
115 *(p++) = '.';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
116 *(p++) = '#';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
117 memcpy (p, file_name + dirlen, XSTRING_LENGTH (fn) - dirlen + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 /* Lock the lock file named LFNAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 If FORCE is nonzero, we do so even if it is already locked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Return 1 if successful, 0 if not. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
125 lock_file_1 (Intbyte *lfname, int force)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
127 /* Does not GC. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
128 int err;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
129 Intbyte *lock_info_str;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
130 Intbyte *host_name;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
131 Intbyte *user_name = user_login_name (NULL);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
133 if (user_name == NULL)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
134 user_name = (Intbyte *) "";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
135
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
136 if (STRINGP (Vsystem_name))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
137 host_name = XSTRING_DATA (Vsystem_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
139 host_name = (Intbyte *) "";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
140
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
141 lock_info_str =
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 793
diff changeset
142 (Intbyte *) ALLOCA (qxestrlen (user_name) + qxestrlen (host_name)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
143 + LOCK_PID_MAX + 5);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
145 qxesprintf (lock_info_str, "%s@%s.%d", user_name, host_name, qxe_getpid ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
147 err = qxe_symlink (lock_info_str, lfname);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
148 if (err != 0 && errno == EEXIST && force)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
150 qxe_unlink (lfname);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
151 err = qxe_symlink (lock_info_str, lfname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 return err == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 1 if another process owns it (and set OWNER (if non-null) to info),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 2 if the current process owns it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 or -1 if something is wrong with the locking mechanism. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
163 current_lock_owner (lock_info_type *owner, Intbyte *lfname)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
165 /* Does not GC. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
166 int len, ret;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 int local_owner = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
168 Intbyte *at, *dot;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
169 Intbyte *lfinfo = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 int bufsize = 50;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 /* Read arbitrarily-long contents of symlink. Similar code in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 file-symlink-p in fileio.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 bufsize *= 2;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
176 lfinfo = (Intbyte *) xrealloc (lfinfo, bufsize);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
177 len = qxe_readlink (lfname, lfinfo, bufsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 while (len >= bufsize);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
180
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 /* If nonexistent lock file, all is well; otherwise, got strange error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 if (len == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 xfree (lfinfo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 return errno == ENOENT ? 0 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 /* Link info exists, so `len' is its length. Null terminate. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 lfinfo[len] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
190
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 /* Even if the caller doesn't want the owner info, we still have to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 read it to determine return value, so allocate it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 if (!owner)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 {
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 793
diff changeset
195 owner = (lock_info_type *) ALLOCA (sizeof (lock_info_type));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 local_owner = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
198
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 /* Parse USER@HOST.PID. If can't parse, return -1. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 /* The USER is everything before the first @. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
201 at = qxestrchr (lfinfo, '@');
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
202 dot = qxestrrchr (lfinfo, '.');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 if (!at || !dot) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 xfree (lfinfo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 len = at - lfinfo;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
208 owner->user = (Intbyte *) xmalloc (len + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
209 qxestrncpy (owner->user, lfinfo, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 owner->user[len] = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
211
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 /* The PID is everything after the last `.'. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
213 owner->pid = atoi ((CIntbyte *) dot + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 /* The host is everything in between. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 len = dot - at - 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
217 owner->host = (Intbyte *) xmalloc (len + 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
218 qxestrncpy (owner->host, at + 1, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 owner->host[len] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 /* We're done looking at the link info. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 xfree (lfinfo);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
223
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 /* On current host? */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
225 if (STRINGP (Fsystem_name ())
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
226 && qxestrcmp (owner->host, XSTRING_DATA (Fsystem_name ())) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
228 if (owner->pid == qxe_getpid ())
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 ret = 2; /* We own it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 else if (owner->pid > 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 && (kill (owner->pid, 0) >= 0 || errno == EPERM))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 ret = 1; /* An existing process on this machine owns it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 /* The owner process is dead or has a strange pid (<=0), so try to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 zap the lockfile. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
235 else if (qxe_unlink (lfname) < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 ret = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 { /* If we wanted to support the check for stale locks on remote machines,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 here's where we'd do it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ret = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
245
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 /* Avoid garbage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 if (local_owner || ret <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 FREE_LOCK_INFO (*owner);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 /* Lock the lock named LFNAME if possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 Return 0 in that case.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 Return positive if some other process owns the lock, and info about
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 that process in CLASHER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 Return -1 if cannot lock for any other reason. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 static int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
261 lock_if_free (lock_info_type *clasher, Intbyte *lfname)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
263 /* Does not GC. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
264 if (lock_file_1 ((Intbyte *) lfname, 0) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 int locker;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 if (errno != EEXIST)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 return -1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
270
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 locker = current_lock_owner (clasher, lfname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 if (locker == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 FREE_LOCK_INFO (*clasher);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 return 0; /* We ourselves locked it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 else if (locker == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 return 1; /* Someone else has it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 return -1; /* Something's wrong. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 /* lock_file locks file FN,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 meaning it serves notice on the world that you intend to edit that file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 This should be done only when about to modify a file-visiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 buffer previously unmodified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 Do not (normally) call this for a buffer already modified,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 as either the file is already locked, or the user has already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 decided to go ahead without locking.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 When this returns, either the lock is locked for us,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 or the user has said to go ahead without locking.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 If the file is locked by someone else, this calls
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 ask-user-about-lock (a Lisp function) with two arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 the file name and info about the user who did the locking.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 This function can signal an error, or return t meaning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 take away the lock, or return nil meaning ignore the lock. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 lock_file (Lisp_Object fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
305 /* This function can GC. GC checked 7-11-00 ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 /* dmoore - and can destroy current_buffer and all sorts of other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 mean nasty things with pointy teeth. If you call this make sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 you protect things right. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
309 /* Somebody updated the code in this function and removed the previous
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 comment. -slb */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 register Lisp_Object attack, orig_fn;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
313 register Intbyte *lfname, *locker;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 lock_info_type lock_info;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
315 struct gcpro gcpro1, gcpro2, gcpro3;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
316 Lisp_Object old_current_buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 Lisp_Object subject_buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
319 if (inhibit_clash_detection)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
320 return;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
321
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
322 old_current_buffer = wrap_buffer (current_buffer);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
323 subject_buf = Qnil;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
324 GCPRO3 (fn, subject_buf, old_current_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 orig_fn = fn;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 fn = Fexpand_file_name (fn, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 /* Create the name of the lock-file for file fn */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 MAKE_LOCK_NAME (lfname, fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 /* See if this file is visited and has changed on disk since it was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 visited. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 subject_buf = get_truename_buffer (orig_fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 if (!NILP (subject_buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 && NILP (Fverify_visited_file_modtime (subject_buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 && !NILP (Ffile_exists_p (fn)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
338 call1_in_buffer (XBUFFER (subject_buf),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
339 Qask_user_about_supersession_threat, fn);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 /* Try to lock the lock. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
343 if (current_buffer != XBUFFER (old_current_buffer)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
344 || lock_if_free (&lock_info, lfname) <= 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
345 /* Return now if we have locked it, or if lock creation failed
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
346 or current buffer is killed. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 /* Else consider breaking the lock */
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 793
diff changeset
350 locker = (Intbyte *) ALLOCA (qxestrlen (lock_info.user)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
351 + qxestrlen (lock_info.host)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
352 + LOCK_PID_MAX + 9);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
353 qxesprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
354 lock_info.pid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 FREE_LOCK_INFO (lock_info);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
356
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 current_buffer, Qask_user_about_lock , fn,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
359 build_intstring (locker));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
360 if (!NILP (attack) && current_buffer == XBUFFER (old_current_buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 /* User says take the lock */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 lock_file_1 (lfname, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 /* User says ignore the lock */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 unlock_file (Lisp_Object fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
374 /* This can GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
375 register Intbyte *lfname;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
376 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
377
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
378 GCPRO1 (fn);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 fn = Fexpand_file_name (fn, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 MAKE_LOCK_NAME (lfname, fn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 if (current_lock_owner (0, lfname) == 2)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
385 qxe_unlink (lfname);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
386
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
387 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
391 unlock_all_files (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 register Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
395 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
397 struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 unlock_file (b->file_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
404 Lock FILE, if current buffer is modified.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
405 FILE defaults to current buffer's visited file,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 or else nothing is done if current buffer isn't visiting a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
408 (file))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (NILP (file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 file = current_buffer->file_truename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 CHECK_STRING (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 && !NILP (file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 lock_file (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 Unlock the file visited in the current buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 if it should normally be locked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 /* dmoore - and can destroy current_buffer and all sorts of other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 mean nasty things with pointy teeth. If you call this make sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 you protect things right. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 && STRINGP (current_buffer->file_truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 unlock_file (current_buffer->file_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 /* Unlock the file visited in buffer BUFFER. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 unlock_buffer (struct buffer *buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 /* dmoore - and can destroy current_buffer and all sorts of other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 mean nasty things with pointy teeth. If you call this make sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 you protect things right. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 && STRINGP (buffer->file_truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 unlock_file (buffer->file_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
452 Return nil if the FILENAME is not locked,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 t if it is locked by you, else a string of the name of the locker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
455 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 Lisp_Object ret;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
458 register Intbyte *lfname;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 int owner;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 lock_info_type locker;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
461 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
462
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
463 GCPRO1 (filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 filename = Fexpand_file_name (filename, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 MAKE_LOCK_NAME (lfname, filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 owner = current_lock_owner (&locker, lfname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 if (owner <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 ret = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 else if (owner == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 ret = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 else
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
475 ret = build_intstring (locker.user);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 if (owner > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 FREE_LOCK_INFO (locker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
480 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 434
diff changeset
481
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 /* Initialization functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 syms_of_filelock (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 DEFSUBR (Funlock_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 DEFSUBR (Flock_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 DEFSUBR (Ffile_locked_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
496 DEFSYMBOL (Qask_user_about_supersession_threat);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
497 DEFSYMBOL (Qask_user_about_lock);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
500 void
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
501 vars_of_filelock (void)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
502 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
503 DEFVAR_BOOL ("inhibit-clash-detection", &inhibit_clash_detection /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
504 Non-nil inhibits creation of lock file to detect clash.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
505 */);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
506 inhibit_clash_detection = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
507 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 #endif /* CLASH_DETECTION */