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