lisp/net/tramp-compat.el

   1 ;;; tramp-compat.el --- Tramp compatibility functions  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2007-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, processes
   7 ;; Package: tramp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Tramp's main Emacs version for development is Emacs 27.  This
  27 ;; package provides compatibility functions for Emacs 24, Emacs 25 and
  28 ;; Emacs 26.
  29
  30 ;;; Code:
  31
  32 (require 'auth-source)
  33 (require 'advice)
  34 (require 'cl-lib)
  35 (require 'custom)
  36 (require 'format-spec)
  37 (require 'parse-time)
  38 (require 'password-cache)
  39 (require 'shell)
  40 (require 'timer)
  41 (require 'ucs-normalize)
  42
  43 (require 'tramp-loaddefs)
  44
  45 ;; For not existing functions, obsolete functions, or functions with a
  46 ;; changed argument list, there are compiler warnings.  We want to
  47 ;; avoid them in cases we know what we do.
  48 (defmacro tramp-compat-funcall (function &rest arguments)
  49   "Call FUNCTION if it exists.  Do not raise compiler warnings."
  50   `(when (functionp ,function)
  51      (with-no-warnings (funcall ,function ,@arguments))))
  52
  53 (defsubst tramp-compat-temporary-file-directory ()
  54   "Return name of directory for temporary files.
  55 It is the default value of `temporary-file-directory'."
  56   ;; We must return a local directory.  If it is remote, we could run
  57   ;; into an infloop.
  58   (eval (car (get 'temporary-file-directory 'standard-value))))
  59
  60 (defsubst tramp-compat-make-temp-file (f &optional dir-flag)
  61   "Create a local temporary file (compat function).
  62 Add the extension of F, if existing."
  63   (let* (file-name-handler-alist
  64          (prefix (expand-file-name
  65                   (symbol-value 'tramp-temp-name-prefix)
  66                   (tramp-compat-temporary-file-directory)))
  67          (extension (file-name-extension f t)))
  68     (make-temp-file prefix dir-flag extension)))
  69
  70 ;; `temporary-file-directory' as function is introduced with Emacs 26.1.
  71 (defalias 'tramp-compat-temporary-file-directory-function
  72   (if (fboundp 'temporary-file-directory)
  73       'temporary-file-directory
  74     'tramp-handle-temporary-file-directory))
  75
  76 (defun tramp-compat-process-running-p (process-name)
  77   "Returns t if system process PROCESS-NAME is running for `user-login-name'."
  78   (when (stringp process-name)
  79     (cond
  80      ;; GNU Emacs 22 on w32.
  81      ((fboundp 'w32-window-exists-p)
  82       (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
  83
  84      ;; GNU Emacs 23.
  85      ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
  86       (let (result)
  87         (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
  88           (let ((attributes (process-attributes pid)))
  89             (when (and (string-equal
  90                         (cdr (assoc 'user attributes)) (user-login-name))
  91                        (let ((comm (cdr (assoc 'comm attributes))))
  92                          ;; The returned command name could be truncated
  93                          ;; to 15 characters.  Therefore, we cannot check
  94                          ;; for `string-equal'.
  95                          (and comm (string-match
  96                                     (concat "^" (regexp-quote comm))
  97                                     process-name))))
  98               (setq result t)))))))))
  99
 100 ;; `default-toplevel-value' has been declared in Emacs 24.4.
 101 (unless (fboundp 'default-toplevel-value)
 102   (defalias 'default-toplevel-value 'symbol-value))
 103
 104 ;; `file-attribute-*' are introduced in Emacs 25.1.
 105
 106 (if (fboundp 'file-attribute-type)
 107     (defalias 'tramp-compat-file-attribute-type 'file-attribute-type)
 108   (defsubst tramp-compat-file-attribute-type (attributes)
 109     "The type field in ATTRIBUTES returned by `file-attributes'.
 110 The value is either t for directory, string (name linked to) for
 111 symbolic link, or nil."
 112     (nth 0 attributes)))
 113
 114 (if (fboundp 'file-attribute-link-number)
 115     (defalias 'tramp-compat-file-attribute-link-number
 116       'file-attribute-link-number)
 117   (defsubst tramp-compat-file-attribute-link-number (attributes)
 118     "Return the number of links in ATTRIBUTES returned by `file-attributes'."
 119     (nth 1 attributes)))
 120
 121 (if (fboundp 'file-attribute-user-id)
 122     (defalias 'tramp-compat-file-attribute-user-id 'file-attribute-user-id)
 123   (defsubst tramp-compat-file-attribute-user-id (attributes)
 124     "The UID field in ATTRIBUTES returned by `file-attributes'.
 125 This is either a string or a number.  If a string value cannot be
 126 looked up, a numeric value, either an integer or a float, is
 127 returned."
 128     (nth 2 attributes)))
 129
 130 (if (fboundp 'file-attribute-group-id)
 131     (defalias 'tramp-compat-file-attribute-group-id 'file-attribute-group-id)
 132   (defsubst tramp-compat-file-attribute-group-id (attributes)
 133     "The GID field in ATTRIBUTES returned by `file-attributes'.
 134 This is either a string or a number.  If a string value cannot be
 135 looked up, a numeric value, either an integer or a float, is
 136 returned."
 137     (nth 3 attributes)))
 138
 139 (if (fboundp 'file-attribute-modification-time)
 140     (defalias 'tramp-compat-file-attribute-modification-time
 141       'file-attribute-modification-time)
 142   (defsubst tramp-compat-file-attribute-modification-time (attributes)
 143     "The modification time in ATTRIBUTES returned by `file-attributes'.
 144 This is the time of the last change to the file's contents, and
 145 is a list of integers (HIGH LOW USEC PSEC) in the same style
 146 as (current-time)."
 147     (nth 5 attributes)))
 148
 149 (if (fboundp 'file-attribute-size)
 150     (defalias 'tramp-compat-file-attribute-size 'file-attribute-size)
 151   (defsubst tramp-compat-file-attribute-size (attributes)
 152     "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
 153 This is a floating point number if the size is too large for an integer."
 154     (nth 7 attributes)))
 155
 156 (if (fboundp 'file-attribute-modes)
 157     (defalias 'tramp-compat-file-attribute-modes 'file-attribute-modes)
 158   (defsubst tramp-compat-file-attribute-modes (attributes)
 159     "The file modes in ATTRIBUTES returned by `file-attributes'.
 160 This is a string of ten letters or dashes as in ls -l."
 161     (nth 8 attributes)))
 162
 163 ;; `format-message' is new in Emacs 25.1.
 164 (unless (fboundp 'format-message)
 165   (defalias 'format-message 'format))
 166
 167 ;; `directory-name-p' is new in Emacs 25.1.
 168 (if (fboundp 'directory-name-p)
 169     (defalias 'tramp-compat-directory-name-p 'directory-name-p)
 170   (defsubst tramp-compat-directory-name-p (name)
 171     "Return non-nil if NAME ends with a directory separator character."
 172     (let ((len (length name))
 173           (lastc ?.))
 174       (if (> len 0)
 175           (setq lastc (aref name (1- len))))
 176       (or (= lastc ?/)
 177           (and (memq system-type '(windows-nt ms-dos))
 178                (= lastc ?\\))))))
 179
 180 ;; `file-missing' is introduced in Emacs 26.1.
 181 (defconst tramp-file-missing
 182   (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
 183   "The error symbol for the `file-missing' error.")
 184
 185 ;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
 186 ;; introduced in Emacs 26.
 187 (eval-and-compile
 188   (if (fboundp 'file-name-quoted-p)
 189       (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p)
 190     (defsubst tramp-compat-file-name-quoted-p (name)
 191       "Whether NAME is quoted with prefix \"/:\".
 192 If NAME is a remote file name, check the local part of NAME."
 193       (string-match "^/:" (or (file-remote-p name 'localname) name))))
 194
 195   (if (fboundp 'file-name-quote)
 196       (defalias 'tramp-compat-file-name-quote 'file-name-quote)
 197     (defsubst tramp-compat-file-name-quote (name)
 198       "Add the quotation prefix \"/:\" to file NAME.
 199 If NAME is a remote file name, the local part of NAME is quoted."
 200       (if (tramp-compat-file-name-quoted-p name)
 201           name
 202         (concat
 203          (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))))
 204
 205   (if (fboundp 'file-name-unquote)
 206       (defalias 'tramp-compat-file-name-unquote 'file-name-unquote)
 207     (defsubst tramp-compat-file-name-unquote (name)
 208       "Remove quotation prefix \"/:\" from file NAME.
 209 If NAME is a remote file name, the local part of NAME is unquoted."
 210       (save-match-data
 211         (let ((localname (or (file-remote-p name 'localname) name)))
 212           (when (tramp-compat-file-name-quoted-p localname)
 213             (setq
 214              localname
 215              (replace-match
 216               (if (= (length localname) 2) "/" "") nil t localname)))
 217           (concat (file-remote-p name) localname))))))
 218
 219 ;; `tramp-syntax' has changed its meaning in Emacs 26.  We still
 220 ;; support old settings.
 221 (defsubst tramp-compat-tramp-syntax ()
 222   "Return proper value of `tramp-syntax'."
 223   (cond ((eq tramp-syntax 'ftp) 'default)
 224         ((eq tramp-syntax 'sep) 'separate)
 225         (t tramp-syntax)))
 226
 227 ;; `cl-struct-slot-info' has been introduced with Emacs 25.
 228 (defmacro tramp-compat-tramp-file-name-slots ()
 229   (if (fboundp 'cl-struct-slot-info)
 230       `(cdr (mapcar 'car (cl-struct-slot-info 'tramp-file-name)))
 231     `(cdr (mapcar 'car (get 'tramp-file-name 'cl-struct-slots)))))
 232
 233 ;; The signature of `tramp-make-tramp-file-name' has been changed.
 234 ;; Therefore, we cannot us `url-tramp-convert-url-to-tramp' prior
 235 ;; Emacs 26.1.  We use `temporary-file-directory' as indicator.
 236 (defconst tramp-compat-use-url-tramp-p (fboundp 'temporary-file-directory)
 237   "Whether to use url-tramp.el.")
 238
 239 (add-hook 'tramp-unload-hook
 240           (lambda ()
 241             (unload-feature 'tramp-loaddefs 'force)
 242             (unload-feature 'tramp-compat 'force)))
 243
 244 (provide 'tramp-compat)
 245
 246 ;;; TODO:
 247
 248 ;;; tramp-compat.el ends here