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