1# -*-Perl-*- 2################################################################ 3### 4### GetPass.pm 5### 6### Author: Internet Message Group <img@mew.org> 7### Created: Apr 30, 1997 8### Revised: Apr 23, 2007 9### 10 11my $PM_VERSION = "IM::GetPass.pm version 20161010(IM153)"; 12 13package IM::GetPass; 14require 5.003; 15require Exporter; 16 17use IM::Config; 18use IM::Util; 19use integer; 20use strict; 21use vars qw(@ISA @EXPORT); 22 23@ISA = qw(Exporter); 24@EXPORT = qw(getpass getpass_interact 25 loadpass savepass connect_agent talk_agent findpass); 26 27sub getpass($$$$) { 28 my($proto, $auth, $host, $user) = @_; 29 my $pass = ''; 30 my $agtfound = 0; 31 my $interact = 0; 32 33 if (&usepwagent()) { 34 $pass = &loadpass($proto, $auth, $host, $user); 35 $agtfound = 1 if ($pass ne ''); 36 } 37 if ($pass eq '' && &usepwfiles()) { 38 $pass = &findpass($proto, $auth, $host, $user); 39 } 40 my $prompt = lc("$proto/$auth:$user\@$host"); 41 if ($pass eq '') { 42 $pass = &getpass_interact("Password ($prompt): "); 43 $interact = 1; 44 } 45 return ($pass, $agtfound, $interact); 46} 47 48sub getpass_interact($) { 49 my($prompt) = @_; 50 my($secret, $termios, $c_lflag); 51 52 if (! -t STDIN) { 53 # stty is not effective for Mule since it's not terminal base. 54 # Anyway, Mew never echos back even if getpass echos back. 55 } elsif (eval 'require POSIX' & !win95p()) { 56 import POSIX qw(termios_h); 57 $termios = new POSIX::Termios; 58 $termios->getattr(fileno(STDIN)); 59 $c_lflag = $termios->getlflag; 60 $termios->setlflag($c_lflag & ~&POSIX::ECHO); 61 $termios->setattr(fileno(STDIN), &POSIX::TCSANOW); 62 } elsif (unixp()) { # non-POSIX-ish UNIX. 63 # stty might be available. 64 my($OldPath) = $ENV{'PATH'}; # for SUID version 65 $ENV{'PATH'} = '/bin:/usr/bin'; 66 system('/bin/stty -echo'); # Ignore errors. 67 $ENV{'PATH'} = $OldPath; 68 } 69 # POSIX doesn't exist for Win95, sigh. 70 71 print STDERR $prompt; 72 flush('STDERR'); 73 chomp($secret = <STDIN>); 74 print STDERR "\n"; 75 flush('STDERR'); 76 77 if (! -t STDIN) { 78 # no operation 79 } elsif (defined $termios) { # POSIX-ish 80 $termios->setlflag($c_lflag); 81 $termios->setattr(fileno(STDIN), &POSIX::TCSANOW); 82 } elsif (unixp()) { # non-POSIX-ish UNIX. 83 my($OldPath) = $ENV{'PATH'}; # for SUID version 84 $ENV{'PATH'} = '/bin:/usr/bin'; 85 system('/bin/stty echo'); # Ignore errors. 86 $ENV{'PATH'} = $OldPath; 87 } 88 89 return $secret; 90} 91 92sub loadpass($$$$) { 93 my($proto, $auth, $path, $user) = @_; 94 local($_); 95 my $key = &connect_agent(0); 96 return '' if ($key eq ''); 97 my @keys = unpack('C*', $key); 98 my $pass = &talk_agent("LOAD\t$proto\t$auth\t$path\t$user\n"); 99 if ($pass =~ /^PASS\t(.*)/) { 100 my @tmp1 = unpack('C*', pack('H*', $1)); 101 my $sum1 = $keys[0]; 102 foreach (@tmp1) { 103 $sum1 += $keys[1]; 104 my $tmp2 = $_; 105 $_ -= $sum1; 106 $_ &= 0xff; 107 $sum1 = $tmp2; 108 } 109 return pack('C*', @tmp1); 110 } else { 111 return ''; 112 } 113} 114 115sub savepass($$$$$) { 116 my($proto, $auth, $path, $user, $pass) = @_; 117 local($_); 118 my $key = &connect_agent(0); 119 return '' if ($key eq ''); 120 my @keys = unpack('C*', $key); 121 my @tmp1 = unpack('C*', $pass); 122 my $sum1 = $keys[0]; 123 foreach (@tmp1) { 124 $sum1 += $_ + $keys[1]; 125 $sum1 &= 0xff; 126 $_ = $sum1; 127 } 128 $pass = unpack('H*', pack('C*', @tmp1)); 129 &talk_agent("SAVE\t$proto\t$auth\t$path\t$user\nPASS\t$pass\n", 0); 130} 131 132sub connect_agent($) { 133 my($surpresserror) = shift; 134 require Socket && import Socket; 135 136 my $realuser = im_getlogin(); 137 unless ($realuser) { 138 im_warn("pwagent: cannot get login name\n") unless ($surpresserror); 139 return ''; 140 } 141 my $dir = &pwagent_tmp_path() . "-$realuser"; 142 143 my $port = &pwagentport(); 144 if ($port > 0) { 145 unless (socket(SOCK, &AF_INET, &SOCK_STREAM, 0)) { 146 im_warn("pwagent: socket: $!\n") unless ($surpresserror); 147 return ''; 148 } 149 my $sin = sockaddr_in($port, inet_aton('127.0.0.1')); 150 unless (connect(SOCK, $sin)) { 151 im_warn("pwagent: connect: $!\n") unless ($surpresserror); 152 return ''; 153 } 154 } else { 155 my $name = "$dir/pw"; 156 157 unless (-S $name) { 158 im_warn("pwagent: cannot access to socket: $name\n") 159 unless ($surpresserror); 160 return ''; 161 } 162 163 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev) = stat($dir); 164 if ($mode & 0077) { 165 im_warn("pwagent: invalid mode: $dir\n") unless ($surpresserror); 166 return ''; 167 } 168 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev) = stat($name); 169 if ($mode & 0077) { 170 im_warn("pwagent: invalid mode: $name\n") unless ($surpresserror); 171 return ''; 172 } 173 174 unless (socket(SOCK, &AF_UNIX, &SOCK_STREAM, 0)) { 175 im_warn("pwagent: socket: $!\n") unless ($surpresserror); 176 return ''; 177 } 178 my $sun = sockaddr_un($name); 179 unless (connect(SOCK, $sun)) { 180 im_warn("pwagent: connect: $!\n") unless ($surpresserror); 181 return ''; 182 } 183 } 184 select(SOCK); $| = 1; select(STDOUT); 185 my $res = <SOCK>; 186 chomp($res); 187 return $res; 188} 189 190sub talk_agent($) { 191 my($msg) = shift; 192 print SOCK $msg; 193 my $res = <SOCK>; 194 shutdown (SOCK, 2); 195 close(SOCK); 196 chomp($res); 197 return $res; 198} 199 200sub findpass($$$$) { 201 my($proto, $auth, $host, $user) = @_; 202 local($_); 203 my($passfile); 204 205 foreach $passfile (split(',', &pwfiles())) { 206 $passfile = &expand_path($passfile); 207 next unless (open (PASSFILE, "<$passfile")); 208 while (<PASSFILE>) { 209 chomp; 210 next if (/^(#.*)?$/); 211# s/\s+(\#.*)?$//; # remove comments 212 if (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S.+)$/) { 213 my($tmp_host, $tmp_user, $tmp_pass) = ($2, $3, $4); 214 my($tmp_proto, $tmp_auth) = split('/', $1); 215 if (($tmp_proto eq $proto) 216 && ($tmp_auth eq $auth) 217 && ($tmp_host eq $host) 218 && ($tmp_user eq $user)) { 219 close (PASSFILE); 220 return $tmp_pass; 221 } 222 } 223 } 224 close (PASSFILE); 225 } 226 227 return ''; 228} 229 2301; 231 232__END__ 233 234=head1 NAME 235 236IM::GetPass - get password from tty or ... 237 238=head1 SYNOPSIS 239 240 use IM::GetPass; 241 242 ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user); 243 244=head1 DESCRIPTION 245 246The I<IM::GetPass> module handles password for mail/news servers. 247 248This modules is provided by IM (Internet Message). 249 250=head1 COPYRIGHT 251 252IM (Internet Message) is copyrighted by IM developing team. 253You can redistribute it and/or modify it under the modified BSD 254license. See the copyright file for more details. 255 256=cut 257 258### Copyright (C) 1997, 1998, 1999 IM developing team 259### All rights reserved. 260### 261### Redistribution and use in source and binary forms, with or without 262### modification, are permitted provided that the following conditions 263### are met: 264### 265### 1. Redistributions of source code must retain the above copyright 266### notice, this list of conditions and the following disclaimer. 267### 2. Redistributions in binary form must reproduce the above copyright 268### notice, this list of conditions and the following disclaimer in the 269### documentation and/or other materials provided with the distribution. 270### 3. Neither the name of the team nor the names of its contributors 271### may be used to endorse or promote products derived from this software 272### without specific prior written permission. 273### 274### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND 275### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 276### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 277### PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE 278### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 279### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 280### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 281### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 282### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 283### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 284### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 285