ARCv2

 view release on metacpan or  search on metacpan

lib/Arc/Connection.pm  view on Meta::CPAN

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
{
        my $this = shift;
        return { %{$this->SUPER::members},
                # private:
                        __sasl => undef,   # Authen::SASL Handle
                        __linequeue => [], # internal line buffer (idea From Net::Cmd)
                        __partial => "",   # a partial line (idea From Net::Cmd)
                # protected:
                        _connection => undef,    # IO::Socket for the ARCv2 Connection
                        _cmdclientsock => undef, # IO::Socket for the command connection (encrypted)
                        _select => undef,        # IO::Select for the ARCv2 Connection
                         
                        _authenticated => 0,     # Are we authenticated
                        #_sasl => undef,         # Authen::SASL::Cyrus Handle
                        #_saslmech => "",        # SASL mechnanism used at authentication
                         
                        _cmdparameter => undef,   # parameter after the command
                        _expectedcmds => undef,   # array, which ARCv2 protocol commands are allowed to come next
                        _connected => 0,          # are we connected
                        _username => "anonymous", # username extracted from SASL

lib/Arc/Connection.pm  view on Meta::CPAN

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
        } elsif ($r->fileno == $netsock->fileno) {
                # on client-side the netsock is closed only
                # if the command on server side has ended.
                # so game over
                $stop = 1 if $client;
                close($locout) unless $stop; # Local pipe is not needed anymore
        }
         
        last if $stop;
} else {
        # select the appropriate write-"select"
        my $tsel = $r->fileno == $locin->fileno ? $nwsel : $lwsel;
        # encryption, decode or encode
        $buf = $r->fileno == $locin->fileno ?
                        $this->{_sasl}->encode($buf) :
                        $this->{_sasl}->decode($buf);
 
        # sometimes SASL replies NULL if something is missing  
        # this is normal behaviour, the next buf will complete it
        next unless $buf;

lib/Arc/Connection.pm  view on Meta::CPAN

167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
##in> ... (line)
##out> true if writing has succeeded, otherwise false.
##eg> $this->_SendLine($cmd,"test");
sub _SendLine
{
        my $this = shift;
        return unless @_;
        my $line = join("",@_);
        $line =~ s/\r//g;
        $line =~ s/\n/ /g;
        return $this->_SetError("SendLine only available when connection and select is set.") unless $this->{_connected};
 
        if ($this->{_select}->can_write($this->{timeout})) {
                $this->_Debug(substr ($line,0,30),"..");
                $line .= "\015\012";
                 
# encrypt if necessary
                $line = $this->{_sasl}->encode($line)
                        if $this->{_authenticated} == 1 and $this->{protocol} == 1;
 
                return $this->{_connection}->syswrite($line,4096) > 0;
        } else {
                $this->{_connected} = 0;

lib/Arc/Connection.pm  view on Meta::CPAN

214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
## timeouts and "connection closed by foreign host"'s.
##out> true (and the line) if everything worked fine, otherwise false (undef)
##eg> if (my $line = $this->_RecvLine()) { ... }
sub _RecvLine
{
        my $this = shift;
 
        return shift @{$this->{__linequeue}} if scalar @{$this->{__linequeue}};
 
        # no connection is set not connected
        return $this->_SetError("RecvCommand only Available when connection and select is set.") unless $this->{_connected};
 
        my $partial = defined($this->{__partial}) ? $this->{__partial} : "";
 
        my $buf = "";
        until (scalar @{$this->{__linequeue}}) {
                if ($this->{_select}->can_read($this->{timeout})) { # true if select thinks there is data
                        my $inbuf;
                        unless ($this->{_connection}->sysread($inbuf,4096)) {
                                $this->{_connected} = 0;
                                $this->{_connection}->close();
                                return $this->_SetError("Connection closed by foreign host.");
                        }
# decrypt if possible and necessary
                        $buf = $this->{_sasl}->decode($inbuf)
                                if $this->{_authenticated} == 1 and $this->{protocol} == 1;
                                

lib/Arc/Connection.pod  view on Meta::CPAN

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
B<Description>: IO::Socket for the ARCv2 Connection
 
B<Default value>: undef
 
=item _expectedcmds
 
B<Description>: array, which ARCv2 protocol commands are allowed to come next
 
B<Default value>: undef
 
=item _select
 
B<Description>: IO::Select for the ARCv2 Connection
 
B<Default value>: undef
 
=item _username
 
B<Description>: username extracted from SASL
 
B<Default value>: "anonymous"

lib/Arc/Connection/Client.pm  view on Meta::CPAN

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
sub _Connect
{
        my $this = shift;
 
        $this->{_connection} = new IO::Socket::INET(
                                PeerAddr => $this->{server},
                                PeerPort => $this->{port},
                                Type => SOCK_STREAM,
        ) || return $this->_SetError("Could not create Client socket: $! $@.");
         
# Fill the connected Socket into the select object
        $this->{_select} = new IO::Select($this->{_connection})
                || return $this->_SetError("Select creation failed.");
 
        $this->{_connection}->autoflush(0);
        $this->{_connected} = 1;
 
        return 1;
}
 
## initialize the protocol.
## Sends the initial protocol message ARC/2.0

lib/Arc/Connection/Client.pod  view on Meta::CPAN

191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
B<Description>: IO::Socket for the ARCv2 Connection
 
B<Default value>: undef
 
=item _expectedcmds I<inherited from Arc::Connection>
 
B<Description>: array, which ARCv2 protocol commands are allowed to come next
 
B<Default value>: undef
 
=item _select I<inherited from Arc::Connection>
 
B<Description>: IO::Select for the ARCv2 Connection
 
B<Default value>: undef
 
=item _username I<inherited from Arc::Connection>
 
B<Description>: username extracted from SASL
 
B<Default value>: "anonymous"

lib/Arc/Connection/Server.pm  view on Meta::CPAN

187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
                        $ret = $this->_Sasl($str);
                }
        } else {
                $ret = $this->_Error("SASL: Negotiation failed. User is not authenticated. (",$sasl->code,") ",
                        $sasl->error);
        }
        return $ret;
}
## parses the AUTHENTICATE[ <SASL mech>]\r\n, sent by the client.
## Checks if the demanded SASL mechanism is allowed and returns the
## selected mechanism.
sub _RAUTHENTICATE
{
        my $this = shift;
 
        if ( $this->{_cmdparameter} ne "") {
                if (grep ({ $_ eq $this->{_cmdparameter}} @{$this->{sasl_mechanisms}} )) {
                        $this->{_saslmech} = $this->{_cmdparameter};
                } else {
                        return $this->_Error("SASL mechanism not allowed by server.");
                }

lib/Arc/Connection/Server.pm  view on Meta::CPAN

401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
## Handles a connection (main loop).
##in> $clientsock (IO::Socket)
##out> true on success, otherwise false
##eg> $arc->HandleClient(sock);
sub HandleClient
{
        my $this = shift;
        return $this->_SetError("Client socket needed.") unless (@_ == 1);
        my $client = shift;
 
# Fill the connected Socket into the select object
        $this->{_connection} = $client;
        $this->{_connected} = 1;
        $this->{_select} = new IO::Select( $client );
 
        my $line = $this->_RecvLine();
        unless ($this->{_error}) {
                if ($line =~ m/^ARC\/2.(0|1)\r?\n$/) { # Protocoltype 2
 
                        $this->{protocol} = $1;
                        $this->Log(LOG_USER,"Arc v2.$1 Session recognized.");
                        $this->_Auth();
 
                        my $cmd;

lib/Arc/Connection/Server.pod  view on Meta::CPAN

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
B<Description>: IO::Socket for the ARCv2 Connection
 
B<Default value>: undef
 
=item _expectedcmds I<inherited from Arc::Connection>
 
B<Description>: array, which ARCv2 protocol commands are allowed to come next
 
B<Default value>: undef
 
=item _select I<inherited from Arc::Connection>
 
B<Description>: IO::Select for the ARCv2 Connection
 
B<Default value>: undef
 
=item _username I<inherited from Arc::Connection>
 
B<Description>: username extracted from SASL
 
B<Default value>: "anonymous"

lib/Arc/Connection/Server.pod  view on Meta::CPAN

399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
$this->_Error("failure.");
 
 
=item _Init (  ) I<reimplemented from Arc::Connection>
 
=item _RAUTHENTICATE (  )
 
B<Description>: parses the AUTHENTICATE[ <SASL mech>]\r\n, sent by the client.
Checks if the demanded SASL mechanism is allowed and returns the
selected mechanism.
 
 
=item _RCMD (  )
 
B<Description>: parses the CMD <cmd>\r\n, sent by the client.
check if the command exists, prepares the command connection, executes the command and
does cleanups after execution.
 
 
=item _RQUIT (  )



( run in 1.456 second using v1.01-cache-2.11-cpan-49f99fa48dc )