File: common.pl

package info (click to toggle)
libauthen-sasl-cyrus-perl 0.13-server-10
  • links: PTS, VCS
  • area: main
  • in suites: buster, jessie, jessie-kfreebsd, stretch
  • size: 348 kB
  • ctags: 43
  • sloc: perl: 241; makefile: 13
file content (77 lines) | stat: -rw-r--r-- 1,141 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

our $me;

1;

# Pluginpath
#$ENV{'SASL_PATH'} = "/opt/products/sasl/1.5.28/lib/sasl";
sub sendreply
{
	$SIG{PIPE} = 'IGNORE'; # Client is closing too fast
	my ($s,$so) = @_;
	$s = " " unless $s;
	print "$me Sendreply: ",substr($s,0,10),"\n";
	syswrite ($so,$s);
}

sub getreply
{
	my ($so) = @_;
	my $s;
	print "$me-Getreply is waiting.\n";
	sysread($so,$s,4096);
	print "$me Getreply: ",substr($s,0,10),"\n";
	return $s;
}

sub checkpass
{
	my ($user,$pass) = @_;
	print "$me CB Checkpass: $user: $pass\n";
	return ($pass eq "klaus");
}

sub getsecret
{
	my ($mech,$user,$realm) = @_;
	print "$me CB Checkpass: $mech, $user, $realm\n";
	return "klaus";
}

sub canonuser 
{
	my ($type,$realm,$maxlen,$user) = @_;
	print "$me CB Canonuser: $type, $realm, $maxlen, $user\n";
	
	return $user;
}

sub authorize
{
	my ($username,$req_user) = @_;

	print "$me CB Authorize: $username, $req_user\n";

#	return $username;
	return 1;
}

sub getusername
{
	print "$me CB username.\n";
	return $ENV{'USER'};
}

sub getauthname
{
	print "$me CB authname.\n";
	return $ENV{'USER'};
}

sub getpassword
{
	print "$me CB password.\n";
	return "klaus";
}