/[tramp]/tramp/lisp/tramp.el
ViewVC logotype

Diff of /tramp/lisp/tramp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2.150 by kai, Sat Jul 27 19:25:53 2002 UTC revision 2.151 by kai, Sun Jul 28 10:00:59 2002 UTC
# Line 1046  corresponding PATTERN matches, the ACTIO Line 1046  corresponding PATTERN matches, the ACTIO
1046    :group 'tramp    :group 'tramp
1047    :type '(repeat (list variable function)))    :type '(repeat (list variable function)))
1048    
1049    (defcustom tramp-multi-actions
1050      '((tramp-password-prompt-regexp tramp-multi-action-password)
1051        (tramp-login-prompt-regexp tramp-multi-action-login)
1052        (shell-prompt-pattern tramp-multi-action-succeed)
1053        (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied))
1054      "List of pattern/action pairs.
1055    This list is used for each hop in multi-hop connections.
1056    See `tramp-actions-before-shell' for more info."
1057      :group 'tramp
1058      :type '(repeat (list variable function)))
1059    
1060  ;;; Internal Variables:  ;;; Internal Variables:
1061    
# Line 1179  $s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1 Line 1189  $s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1
1189  on the remote file system.")  on the remote file system.")
1190    
1191  ;; Perl script to implement `mime-encode'  ;; Perl script to implement `mime-encode'
1192  (defvar tramp-perl-mime-encode (concat  ;; (defvar tramp-perl-mime-encode (concat
1193   "sub encode_base64 ($);  ;;  "sub encode_base64 ($);
1194    my $buf;  ;;   my $buf;
1195    while(read(STDIN, $buf, 60*57)) { print encode_base64($buf) }  ;;   while(read(STDIN, $buf, 60*57)) { print encode_base64($buf) }
1196    sub encode_base64 ($) {  ;;   sub encode_base64 ($) {
1197      my $res = \"\";  ;;     my $res = \"\";
1198      my $eol = \"\n\";  ;;     my $eol = \"\n\";
1199      pos($_[0]) = 0;                          # ensure start at the beginning  ;;     pos($_[0]) = 0;                          # ensure start at the beginning
1200      while ($_[0] =~ /(.{1,45})/gs) {  ;;     while ($_[0] =~ /(.{1,45})/gs) {
1201          $res .= substr(pack(\"u\", $1), 1);  ;;      $res .= substr(pack(\"u\", $1), 1);
1202          chop($res);  ;;      chop($res);
1203      }  ;;     }
1204      $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs  ;;     $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
1205      # fix padding at the end  ;;     # fix padding at the end
1206      my $padding = (3 - length($_[0]) % 3) % 3;  ;;     my $padding = (3 - length($_[0]) % 3) % 3;
1207      $res =~ s/.{$padding}$/\"=\" x $padding/e if $padding;  ;;     $res =~ s/.{$padding}$/\"=\" x $padding/e if $padding;
1208      # break encoded string into lines of no more than 76 characters each  ;;     # break encoded string into lines of no more than 76 characters each
1209      if (length $eol) {  ;;     if (length $eol) {
1210          $res =~ s/(.{1,76})/$1$eol/g;  ;;      $res =~ s/(.{1,76})/$1$eol/g;
1211      }  ;;     }
1212      $res;}"))  ;;     $res;}"))
1213    
1214    (defvar tramp-perl-encode "%s -e'\
1215    print qq(begin 644 xxx\n);
1216    my $s = q();
1217    my $res = q();
1218    while (read(STDIN, $s, 45)) {
1219        print pack(q(u), $s);
1220    }
1221    print qq(`\n);
1222    print qq(end\n);
1223    '"
1224      "Perl program to use for encoding a file.
1225    Escape sequence %s is replaced with name of Perl binary.")
1226    
1227  ;; Perl script to implement `mime-decode'  ;; Perl script to implement `mime-decode'
1228  (defvar tramp-perl-mime-decode (concat  (defvar tramp-perl-decode "%s -ne '
1229   "sub decode_base64 ($);  print unpack q(u), $_;
1230    my $buf;  '"
1231    while(read(STDIN, $buf, 60*57)) { print decode_base64($buf) }    "Perl program to use for decoding a file.
1232    sub decode_base64 ($) {  Escape sequence %s is replaced with name of Perl binary.")
1233      local($^W) = 0; # unpack(\"u\",...) gives bogus warning in 5.00[123]  
1234    ;; (defvar tramp-perl-mime-decode (concat
1235      my $str = shift;  ;;  "sub decode_base64 ($);
1236      my $res = \"\";  ;;   my $buf;
1237    ;;   while(read(STDIN, $buf, 60*57)) { print decode_base64($buf) }
1238      $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars  ;;   sub decode_base64 ($) {
1239      if (length($str) % 4) {  ;;     local($^W) = 0; # unpack(\"u\",...) gives bogus warning in 5.00[123]
1240          warn(\"Length of base64 data not a multiple of 4\")  
1241      }  ;;     my $str = shift;
1242      $str =~ s/=+$//;                        # remove padding  ;;     my $res = \"\";
1243      $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format  
1244      while ($str =~ /(.{1,60})/gs) {  ;;     $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
1245          my $len = chr(32 + length($1)*3/4); # compute length byte  ;;     if (length($str) % 4) {
1246          $res .= unpack(\"u\", $len . $1 );    # uudecode  ;;      warn(\"Length of base64 data not a multiple of 4\")
1247      }  ;;     }
1248      $res;}"))  ;;     $str =~ s/=+$//;                        # remove padding
1249    ;;     $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
1250    ;;     while ($str =~ /(.{1,60})/gs) {
1251    ;;      my $len = chr(32 + length($1)*3/4); # compute length byte
1252    ;;      $res .= unpack(\"u\", $len . $1 );    # uudecode
1253    ;;     }
1254    ;;     $res;}"))
1255    
1256  ; These values conform to `file-attributes' from XEmacs 21.2.  ; These values conform to `file-attributes' from XEmacs 21.2.
1257  ; GNU Emacs and other tools not checked.  ; GNU Emacs and other tools not checked.
# Line 3442  Returns nil if none was found, else the Line 3471  Returns nil if none was found, else the
3471  ;; prompts from the remote host.  See the variable  ;; prompts from the remote host.  See the variable
3472  ;; `tramp-actions-before-shell' for usage of these functions.  ;; `tramp-actions-before-shell' for usage of these functions.
3473    
3474  (defun tramp-action-login (multi-method method user host)  (defun tramp-action-login (p multi-method method user host)
3475    "Send the login name."    "Send the login name."
3476    (tramp-message 9 "Sending login name `%s'"    (tramp-message 9 "Sending login name `%s'"
3477                   (or user (user-login-name)))                   (or user (user-login-name)))
3478    (process-send-string nil (concat (or user (user-login-name))    (process-send-string nil (concat (or user (user-login-name))
3479                                     tramp-rsh-end-of-line)))                                     tramp-rsh-end-of-line)))
3480    
3481  (defun tramp-action-password (multi-method method user host)  (defun tramp-action-password (p multi-method method user host)
3482    "Query the user for a password."    "Query the user for a password."
3483    (when (tramp-method-out-of-band-p multi-method method)    (when (tramp-method-out-of-band-p multi-method method)
3484      (kill-process (get-buffer-process (current-buffer)))      (kill-process (get-buffer-process (current-buffer)))
3485      (error (concat "Out of band method `%s' not applicable "      (error (concat "Out of band method `%s' not applicable "
3486                     "for remote shell asking for a password")                     "for remote shell asking for a password")
3487             method))             method))
3488    (tramp-enter-password (match-string 0)))    (tramp-enter-password p (match-string 0)))
3489    
3490  (defun tramp-action-succeed (multi-method method user host)  (defun tramp-action-succeed (p multi-method method user host)
3491    "Signal success in finding shell prompt."    "Signal success in finding shell prompt."
3492    (tramp-message 9 "Found remote shell prompt.")    (tramp-message 9 "Found remote shell prompt.")
3493    (throw 'tramp-action 'ok))    (throw 'tramp-action 'ok))
3494    
3495  (defun tramp-action-permission-denied (multi-method method user host)  (defun tramp-action-permission-denied (p multi-method method user host)
3496    "Signal permission denied."    "Signal permission denied."
3497    (tramp-message 9 "Permission denied by remote host.")    (tramp-message 9 "Permission denied by remote host.")
3498    (kill-process (get-buffer-process (current-buffer)))    (kill-process p)
3499      (throw 'tramp-action 'permission-denied))
3500    
3501    ;; The following functions are specifically for multi connections.
3502    
3503    (defun tramp-multi-action-login (p method user host)
3504      "Send the login name."
3505      (tramp-message 9 "Sending login name `%s'" user)
3506      (process-send-string p (concat user tramp-rsh-end-of-line)))
3507    
3508    (defun tramp-multi-action-password (p method user host)
3509      "Query the user for a password."
3510      (tramp-enter-password p (match-string 0)))
3511    
3512    (defun tramp-multi-action-succeed (p method user host)
3513      "Signal success in finding shell prompt."
3514      (tramp-message 9 "Found shell prompt on `%s'" host)
3515      (throw 'tramp-action 'ok))
3516    
3517    (defun tramp-multi-action-permission-denied (p method user host)
3518      "Signal permission denied."
3519      (tramp-message 9 "Permission denied by remote host `%s'" host)
3520      (kill-process p)
3521    (throw 'tramp-action 'permission-denied))    (throw 'tramp-action 'permission-denied))
3522    
3523  ;; Functions for processing the actions.  ;; Functions for processing the actions.
3524    
3525  (defun tramp-process-one-action (multi-method method user host actions)  (defun tramp-process-one-action (p multi-method method user host actions)
3526    "Wait for output from the shell and perform one action."    "Wait for output from the shell and perform one action."
3527    (let (found item pattern action)    (let (found item pattern action todo)
3528      (erase-buffer)      (erase-buffer)
3529      (tramp-message 9 "Waiting 60s for prompt from remote shell")      (tramp-message 9 "Waiting 60s for prompt from remote shell")
3530      (with-timeout (60 (throw 'tramp-action 'timeout))      (with-timeout (60 (throw 'tramp-action 'timeout))
3531        (while (not found)        (while (not found)
3532          (accept-process-output (get-buffer-process (current-buffer)) 1)          (accept-process-output p 1)
3533          (goto-char (point-min))          (setq todo actions)
3534          (while actions          (while todo
3535            (setq item (pop actions))            (goto-char (point-min))
3536              (setq item (pop todo))
3537            (setq pattern (symbol-value (nth 0 item)))            (setq pattern (symbol-value (nth 0 item)))
3538            (setq action (nth 1 item))            (setq action (nth 1 item))
3539              (tramp-message 10 "Looking for pattern %s" pattern)
3540            (when (re-search-forward (concat pattern "\\'") nil t)            (when (re-search-forward (concat pattern "\\'") nil t)
3541              (setq found (funcall action multi-method method user host)))))              (setq found (funcall action p multi-method method user host)))))
3542        found)))        found)))
3543    
3544  (defun tramp-process-actions (multi-method method user host actions)  (defun tramp-process-actions (p multi-method method user host actions)
3545    "Perform actions until success."    "Perform actions until success."
3546    (let (exit)    (let (exit)
3547      (while (not exit)      (while (not exit)
3548          (tramp-message 10 "Processing actions")
3549        (setq exit        (setq exit
3550              (catch 'tramp-action              (catch 'tramp-action
3551                (tramp-process-one-action multi-method method user host actions)                (tramp-process-one-action
3552                   p multi-method method user host actions)
3553                nil)))                nil)))
3554      (unless (eq exit 'ok)      (unless (eq exit 'ok)
3555        (error "Login failed"))))        (error "Login failed"))))
3556    
3557    ;; For multi-actions.
3558    
3559    (defun tramp-process-one-multi-action (p method user host actions)
3560      "Wait for output from the shell and perform one action."
3561      (let (found item pattern action todo)
3562        (erase-buffer)
3563        (tramp-message 9 "Waiting 60s for prompt from remote shell")
3564        (with-timeout (60 (throw 'tramp-action 'timeout))
3565          (while (not found)
3566            (accept-process-output p 1)
3567            (setq todo actions)
3568            (while todo
3569              (goto-char (point-min))
3570              (setq item (pop todo))
3571              (setq pattern (symbol-value (nth 0 item)))
3572              (setq action (nth 1 item))
3573              (tramp-message 10 "Looking for pattern %s" pattern)
3574              (when (re-search-forward (concat pattern "\\'") nil t)
3575                (setq found (funcall action p method user host)))))
3576          found)))
3577    
3578    (defun tramp-process-multi-actions (p method user host actions)
3579      "Perform actions until success."
3580      (let (exit)
3581        (while (not exit)
3582          (setq exit
3583                (catch 'tramp-action
3584                  (tramp-process-one-multi-action p method user host actions)
3585                  nil)))
3586        (unless (eq exit 'ok)
3587          (error "Login failed"))))
3588    
3589    ;; The actual functions for opening connections.
3590    
3591  (defun tramp-open-connection-telnet (multi-method method user host)  (defun tramp-open-connection-telnet (multi-method method user host)
3592    "Open a connection using a telnet METHOD.    "Open a connection using a telnet METHOD.
3593  This starts the command `telnet HOST ARGS'[*], then waits for a remote  This starts the command `telnet HOST ARGS'[*], then waits for a remote
# Line 3545  Maybe the different regular expressions Line 3634  Maybe the different regular expressions
3634          (process-kill-without-query p)          (process-kill-without-query p)
3635          (set-buffer (tramp-get-buffer multi-method method user host))          (set-buffer (tramp-get-buffer multi-method method user host))
3636          (erase-buffer)          (erase-buffer)
3637          (tramp-process-actions multi-method method user host          (tramp-process-actions p multi-method method user host
3638                                 tramp-actions-before-shell)                                 tramp-actions-before-shell)
3639    
3640  ;;         (tramp-message 9 "Waiting for login prompt...")  ;;         (tramp-message 9 "Waiting for login prompt...")
# Line 3643  arguments, and xx will be used as the ho Line 3732  arguments, and xx will be used as the ho
3732          (process-kill-without-query p)          (process-kill-without-query p)
3733    
3734          (set-buffer buf)          (set-buffer buf)
3735          (tramp-process-actions multi-method method user host          (tramp-process-actions p multi-method method user host
3736                                 tramp-actions-before-shell)                                 tramp-actions-before-shell)
3737    
3738  ;;         (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host)  ;;         (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host)
# Line 3731  at all unlikely that this variable is se Line 3820  at all unlikely that this variable is se
3820               (pw nil))               (pw nil))
3821          (process-kill-without-query p)          (process-kill-without-query p)
3822          (set-buffer (tramp-get-buffer multi-method method user host))          (set-buffer (tramp-get-buffer multi-method method user host))
3823          (tramp-process-actions multi-method method user host          (tramp-process-actions p multi-method method user host
3824                                 tramp-actions-before-shell)                                 tramp-actions-before-shell)
3825    
3826  ;;         (tramp-message 9 "Waiting 30s for shell or password prompt...")  ;;         (tramp-message 9 "Waiting 30s for shell or password prompt...")
# Line 3852  If USER is nil, uses the return value of Line 3941  If USER is nil, uses the return value of
3941      (erase-buffer)      (erase-buffer)
3942      (tramp-message 9 "Sending telnet command `%s'" cmd1)      (tramp-message 9 "Sending telnet command `%s'" cmd1)
3943      (process-send-string p cmd)      (process-send-string p cmd)
3944      (tramp-process-actions multi-method method user host      (tramp-process-multi-actions p method user host
3945                             tramp-actions-before-shell)                                   tramp-multi-actions)
3946    
3947  ;;     (tramp-message 9 "Waiting 30s for login prompt from %s" host)  ;;     (tramp-message 9 "Waiting 30s for login prompt from %s" host)
3948  ;;     (unless (tramp-wait-for-regexp p 30 tramp-login-prompt-regexp)  ;;     (unless (tramp-wait-for-regexp p 30 tramp-login-prompt-regexp)
# Line 3910  If USER is nil, uses the return value of Line 3999  If USER is nil, uses the return value of
3999      (erase-buffer)      (erase-buffer)
4000      (tramp-message 9 "Sending rlogin command `%s'" cmd1)      (tramp-message 9 "Sending rlogin command `%s'" cmd1)
4001      (process-send-string p cmd)      (process-send-string p cmd)
4002      (tramp-process-actions multi-method method user host      (tramp-process-multi-actions p method user host
4003                             tramp-actions-before-shell)                                   tramp-multi-actions)
4004  ;;     (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host)  ;;     (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host)
4005  ;;     (unless (setq found  ;;     (unless (setq found
4006  ;;                   (tramp-wait-for-regexp p 60  ;;                   (tramp-wait-for-regexp p 60
# Line 3964  character." Line 4053  character."
4053      (erase-buffer)      (erase-buffer)
4054      (tramp-message 9 "Sending su command `%s'" cmd1)      (tramp-message 9 "Sending su command `%s'" cmd1)
4055      (process-send-string p cmd)      (process-send-string p cmd)
4056      (tramp-process-actions multi-method method user host      (tramp-process-multi-actions p method user host
4057                             tramp-actions-before-shell)                                   tramp-multi-actions)
4058  ;;     (tramp-message 9 "Waiting 60s for shell or passwd prompt for %s" (or user (user-login-name)))  ;;     (tramp-message 9 "Waiting 60s for shell or passwd prompt for %s" (or user (user-login-name)))
4059  ;;     (unless (setq found (tramp-wait-for-regexp  ;;     (unless (setq found (tramp-wait-for-regexp
4060  ;;                          p 60 (format "\\(%s\\)\\|\\(%s\\)\\'"  ;;                          p 60 (format "\\(%s\\)\\|\\(%s\\)\\'"
# Line 4304  locale to C and sets up the remote shell Line 4393  locale to C and sets up the remote shell
4393          (tramp-message 5 "Sending the Perl `mime-encode' implementation.")          (tramp-message 5 "Sending the Perl `mime-encode' implementation.")
4394          (tramp-send-linewise          (tramp-send-linewise
4395           multi-method method user host           multi-method method user host
4396           (concat "tramp_mimencode () {\n"           (concat "tramp_encode () {\n"
4397                   (if (tramp-find-executable multi-method method user host                   (format tramp-perl-encode tramp-remote-perl)
4398                                              "mimencode"  tramp-remote-path t)                   " 2>/dev/null"
                      "mimencode -b $1"  
                    (concat tramp-remote-perl  
                            " -e '" tramp-perl-mime-encode "' $1 2>/dev/null"))  
4399                   "\n}"))                   "\n}"))
4400          (tramp-wait-for-output)          (tramp-wait-for-output)
4401          (tramp-message 5 "Sending the Perl `mime-decode' implementation.")          (tramp-message 5 "Sending the Perl `mime-decode' implementation.")
4402          (tramp-send-linewise          (tramp-send-linewise
4403           multi-method method user host           multi-method method user host
4404           (concat "tramp_mimedecode () {\n"           (concat "tramp_decode () {\n"
4405                   (if (tramp-find-executable multi-method method user host                   (format tramp-perl-decode tramp-remote-perl)
4406                                              "mimencode"  tramp-remote-path t)                   " 2>/dev/null"
                      "mimencode -u -b $1"  
                    (concat tramp-remote-perl  
                            " -e '" tramp-perl-mime-decode "' $1 2>/dev/null"))  
4407                   "\n}"))                   "\n}"))
4408          (tramp-wait-for-output))))          (tramp-wait-for-output))))
4409    ;; Find ln(1)    ;; Find ln(1)
# Line 4360  locale to C and sets up the remote shell Line 4443  locale to C and sets up the remote shell
4443        (tramp-message        (tramp-message
4444         5 "Checking to see if encoding/decoding commands work on remote host...done"))))         5 "Checking to see if encoding/decoding commands work on remote host...done"))))
4445    
4446    ;; XXX adapt rest of code to new mechanism.
4447    ;; We now have remote and local encoders and decoders, and each can be
4448    ;; a string (shell command) or a symbol (Lisp function).
4449  (defvar tramp-coding-commands  (defvar tramp-coding-commands
4450    '(("mimencode -b" "mimencode -u -b"    `(("tramp_encode" "tramp_decode"
4451         "uuencode xxx" uudecode-decode-region)
4452        ("mimencode -b" "mimencode -u -b"
4453       base64-encode-region base64-decode-region)       base64-encode-region base64-decode-region)
4454      ("mmencode -b" "mmencode -u -b"      ("mmencode -b" "mmencode -u -b"
4455       base64-encode-region base64-decode-region)       base64-encode-region base64-decode-region)
     ("tramp_mimencode" "tramp_mimedecode"  
      base64-encode-region base64-encode-region)  
4456      ("uuencode xxx" "uudecode -o -"      ("uuencode xxx" "uudecode -o -"
4457       nil uudecode-decode-region)       "uuencode xxx" uudecode-decode-region)
4458      ("uuencode xxx" "uudecode -p"      ("uuencode xxx" "uudecode -p"
4459       nil uudecode-decode-region))       "uuencode xxx" uudecode-decode-region))
4460    "List of coding commands for inline transfer.    "List of coding commands for inline transfer.
4461  Each item is a list (ENCODING-COMMAND DECODING-COMMAND  Each item is a list (REMOTE-ENCODING REMOTE-DECODING
4462  ENCODING-FUNCTION DECODING-FUNCTION).  LOCAL-ENCODING LOCAL-DECODING).
4463    
4464    Each item can be a string, giving a command, or a symbol, giving
4465    a function.
4466    
4467  The ENCODING-COMMAND should be a command accepting a plain file on  The ENCODING-COMMAND should be a command accepting a plain file on
4468  standard input and writing the encoded file to standard output.  The  standard input and writing the encoded file to standard output.  The

Legend:
Removed from v.2.150  
changed lines
  Added in v.2.151

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26