Chase symlinks manually.
[bpt/emacs.git] / lisp / mail / blessmail.el
1 ;;; blessmail.el --- Decide whether movemail needs special privileges.
2
3 ;;; Copyright (C) 1994 Free Software Foundation, Inc.
4
5 ;; Maintainer: FSF
6 ;; Keywords: internal
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;; This is loaded into a bare Emacs to create the blessmail script,
27 ;; which (on systems that need it) is used during installation
28 ;; to give appropriate permissions to movemail.
29 ;;
30 ;; It has to be done from lisp in order to be sure of getting the
31 ;; correct value of rmail-spool-directory.
32
33 ;;; Code:
34
35 (message "Using load-path %s" load-path)
36 (load "paths.el")
37 (load "site-init" t)
38
39 (let ((dirname rmail-spool-directory) linkname attr modes)
40 ;; Check for symbolic link
41 (while (setq linkname (file-symlink-p dirname))
42 (setq dirname (if (file-name-absolute-p linkname)
43 linkname
44 (concat (file-name-directory dirname) linkname))))
45 (setq attr (file-attributes dirname))
46 (or (eq t (car attr))
47 (signal 'error
48 (list (format "%s is not a directory" rmail-spool-directory))))
49 (setq modes (nth 8 attr))
50 (insert "#!/bin/sh\n")
51 (cond
52 ((= ?w (aref modes 8))
53 (insert "exit 0"))
54 ((= ?w (aref modes 5))
55 (insert "chgrp " (number-to-string (nth 3 attr))
56 " $* && chmod g+s $*\n"))
57 ((= ?w (aref modes 2))
58 (insert "chown " (number-to-string (nth 2 attr))
59 " $* && chmod u+s $*\n"))
60 (t
61 (insert "chown root $* && chmod u+s $*\n"))))
62 (write-region (point-min) (point-max) "blessmail")
63 (kill-emacs)
64
65 ;;; blessmail.el ends here