File: Security.pm

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 (121 lines) | stat: -rwxr-xr-x 3,138 bytes parent folder | download | duplicates (4)
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
#
# Add SASL encoding/decoding to a filehandle
#

package Authen::SASL::Cyrus::Security;


sub TIEHANDLE {
  my($class, $fh, $conn) = @_;
  my($ref);

  $ref->{fh} = $fh;
  $ref->{conn} = $conn;

  bless($ref,$class);
  return($ref);
}

sub FILENO {
  my($ref) = @_;
  return(fileno($ref->{fh}));
}

sub READ {
  my($ref, $buf, $len, $offset) = @_;
  my($need, $didread, $fh, $rc, $cryptbuf, $clearbuf);

  $fh = $ref->{fh};
  $buf = \$_[1];

  # Check if there's leftovers from a previous READ
  $need = $len;
  if ($ref->{readbuf}) {
    # If there's enough in the buffer, just take from there
    if (length($ref->{readbuf}) >= $len) {
      substr($$buf, $offset, $len) = substr($ref->{readbuf}, 0, $len);
      $ref->{readbuf} = substr($ref->{readbuf}, $len);
      return($len);
    }

    # Not enough. Take all of the buffer, and read more
    substr($$buf, $offset, $len) = $ref->{readbuf};
    $didread = length($ref->{readbuf});
    $need -= $didread;
    $offset += $didread;
    $ref->{readbuf} = "";
  }

  # Read in bytes from the socket, and decrypt it
  $rc = sysread($fh, $cryptbuf, $len);
  return($didread) if ($rc <= 0);
  $clearbuf = $ref->{conn}->decode($cryptbuf);
  return(-1) if not defined ($clearbuf);

  # It may be that more encrypted bytes are needed to decrypt an entire "block"
  # If decode() returned nothing, read in more bytes (arbitrary amounts) until
  # an entire encrypted block is available to decrypt.
  while ($clearbuf eq "") {
    $rc = sysread($fh, $cryptbuf, 8);
    return($rc) if ($rc <= 0);
    $clearbuf = $ref->{conn}->decode($cryptbuf);
    return(-1) if not defined ($clearbuf);
  }

  # Copy what was asked for, stash the rest
  substr($$buf, $offset, $need) = substr($clearbuf, 0, $need);
  $ref->{readbuf} = substr($clearbuf, $need);

  return($len);
}

# Encrypting a write() to a filehandle is much easier than reading, because
# all the data to be encrypted is immediately available
sub WRITE {
  my($ref,$string,$len) = @_;
  my($fh, $clearbuf, $cryptbuf, $maxbuf);

  $fh = $ref->{fh};
  $clearbuf = substr($string, 0, $len);
  $len = length($clearbuf);
  $maxbuf = $ref->{conn}->property("maxout");
  if ($len < $maxbuf) {
    $cryptbuf = $ref->{conn}->encode($clearbuf);
    return(-1) if not defined ($cryptbuf);
  } else {
    my ($partial, $chunk, $chunksize);
    my $offset = 0;
    $cryptbuf = '';
    while ($offset < $len) {
      $chunksize = (($offset + $maxbuf) > $len) ? $len - $offset : $maxbuf;
      $chunk = substr($clearbuf, $offset, $chunksize);
      $partial = $ref->{conn}->encode($chunk);
      return(-1) if not defined ($partial);
      $cryptbuf .= $partial;
      $offset += $chunksize;
    }
  }
  return (print $fh $cryptbuf) ? $len : -1;
}

# Given a GLOB ref, tie the filehandle of the GLOB to this class
sub new {
  my($class, $fh, $conn) = @_;
  tie(*{$fh}, $class, $fh, $conn);
}

# Forward close to the tied handle
sub CLOSE {
  my($ref) = @_;
  close($ref->{fh});
  $ref->{fh} = undef;
}

# Avoid getting too circular in the free'ing of an object in this class.
sub DESTROY {
  my($self) = @_;
  delete($self->{fh});
  undef $self;
}

1;