This file is indexed.

/usr/lib/perl5/Ace/SocketServer.pm is in libace-perl 1.92-2build3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
package Ace::SocketServer;

require 5.004;
use strict;
use Carp 'croak','cluck';
use Ace qw(rearrange STATUS_WAITING STATUS_PENDING STATUS_ERROR);
use IO::Socket;
use Digest::MD5 'md5_hex';

use vars '$VERSION';
$VERSION = '1.01';

use constant DEFAULT_USER    => 'anonymous';  # anonymous user
use constant DEFAULT_PASS    => 'guest';      # anonymous password
use constant DEFAULT_TIMEOUT => 120;          # two minute timeout on queries

# header information
use constant HEADER => 'L5a30';
use constant HEADER_LEN => 5*4+30;
use constant ACESERV_MSGREQ   => "ACESERV_MSGREQ";
use constant ACESERV_MSGDATA  => "ACESERV_MSGDATA";
use constant WORDORDER_MAGIC => 0x12345678;

# Server only, it may just be sending or a reply or it may be sending an
# instruction, such as "operation refused".
use constant ACESERV_MSGOK     => "ACESERV_MSGOK";
use constant ACESERV_MSGENCORE => "ACESERV_MSGENCORE";
use constant ACESERV_MSGFAIL   => "ACESERV_MSGFAIL";
use constant ACESERV_MSGKILL   => "ACESERV_MSGKILL";

use constant ACESERV_CLIENT_HELLO => "bonjour";
use constant ACESERV_SERVER_HELLO => "et bonjour a vous";

sub connect {
  my $class = shift;
  my ($host,$port,$timeout,$user,$pass) = rearrange(['HOST','PORT','TIMEOUT','USER','PASS'],@_);
  $user    ||= DEFAULT_USER;
  $pass    ||= DEFAULT_PASS;
  $timeout ||= DEFAULT_TIMEOUT;
  my $s = IO::Socket::INET->new("$host:$port") || 
    return _error("Couldn't establish connection");
  my $self = bless { socket    => $s,
		     client_id => 0,  # client ID provided by server
		     timeout   => $timeout,
		   },$class;
  return unless $self->_handshake($user,$pass);
  $self->{status} = STATUS_WAITING;
  $self->{encoring} = 0;
  return $self;
}

sub DESTROY {
  my $self = shift;
  return if $self->{last_msg} eq ACESERV_MSGKILL;
  $self->_send_msg('quit');
# Is _recv_msg() bringing things down in flames?  Maybe!
  my ($msg,$body) = $self->_recv_msg('strip');
  warn "Did not get expected ACESERV_MSGKILL message, got $msg instead" 
    if defined($msg) and $msg ne ACESERV_MSGKILL;
}

sub encore { return shift->{encoring} }

sub status { shift->{status} }

sub error { $Ace::Error; }

sub query {
  my $self = shift;
  my ($request,$parse) = @_;
  warn "query($request)" if Ace->debug;
  unless ($self->_send_msg($request,$parse)) {
    $self->{status} = STATUS_ERROR;
    return _error("Write to socket server failed: $!");
  }
  $self->{status} = STATUS_PENDING;
  $self->{encoring} = 0;
  return 1;
}

sub read {
  my $self = shift;
  return _error("No pending query") unless $self->status == STATUS_PENDING;
  $self->_do_encore || return if $self->encore;
  # call select() here to time out

  if ($self->{timeout}) {
      my $rdr = '';
      vec($rdr,fileno($self->{socket}),1) = 1;
      my $result = select($rdr,undef,undef,$self->{timeout});
      return _error("Query timed out") unless $result;
  }

  my ($msg,$body) = $self->_recv_msg;
  return unless defined $msg;
  $msg =~ s/\0.+$//;  # socketserver bug workaround: get rid of junk in message
  if ($msg eq ACESERV_MSGOK or $msg eq ACESERV_MSGFAIL) {
    $self->{status}   = STATUS_WAITING;
    $self->{encoring} = 0;
  } elsif ($msg eq ACESERV_MSGENCORE) {
    $self->{status}   = STATUS_PENDING;  # not strictly necessary, but helpful to document
    $self->{encoring} = 1;
  } else {
    $self->{status}   = STATUS_ERROR;
    return _error($body);
  }
  return $body;
}

sub write {
  my $self = shift;
  my $data = shift;
  unless ($self->_send_msg($data,1)) {
    $self->{status} = STATUS_ERROR;
    return _error("Write to socket server failed: $!");
  }
  $self->{status} = STATUS_PENDING;
  $self->{encoring} = 0;
  return 1;
}

sub _error {
  $Ace::Error = shift;
  return;
}

# return socket (read only)
sub socket { $_[0]->{socket} }

# ----------------------------- low level -------------------------------
sub _do_encore {
  my $self = shift;
  unless ($self->_send_msg('encore')) {
    $self->{status} = STATUS_ERROR;
    return _error("Write to socket server failed: $!");
  }
  $self->{status} = STATUS_PENDING;
  return 1;
}
sub _handshake {
  my $self = shift;
  my ($user,$pass) = @_;
  $self->_send_msg(ACESERV_CLIENT_HELLO);
  my ($msg,$nonce) = $self->_recv_msg('strip');
  return unless $msg eq ACESERV_MSGOK;
  # hash username and password
  my $authdigest = md5_hex(md5_hex($user . $pass).$nonce);
  $self->_send_msg("$user $authdigest");
  my $body;
  ($msg,$body) = $self->_recv_msg('strip');
  return _error("server: $body") unless $body eq ACESERV_SERVER_HELLO;
  return 1;
}

sub _send_msg {
  my ($self,$msg,$parse) = @_;
  return unless my $sock = $self->{socket};
  local $SIG{'PIPE'} = 'IGNORE';
  $msg .= "\0";  # add terminating null
  my $request;
  if ($parse) {
    $request = ACESERV_MSGDATA;
  } else {
    $request = $msg eq "encore\0" ? ACESERV_MSGENCORE : ACESERV_MSGREQ;
  }
  my $header  = pack HEADER,WORDORDER_MAGIC,length($msg),0,$self->{client_id},0,$request;
  print $sock $header,$msg;
}

sub _recv_msg {
  my $self = shift;
  my $strip_null = shift;
  return unless my $sock = $self->{socket};
  my ($header,$body);
  my $bytes = CORE::read($sock,$header,HEADER_LEN);
  unless ($bytes > 0) {
    $self->{status} = STATUS_ERROR;
    return _error("Connection closed by remote server: $!");
  }
  my ($magic,$length,$junk1,$clientID,$junk2,$msg) = unpack HEADER,$header;
  $self->{client_id} ||= $clientID;
  $msg =~ s/\0*$//;
  $self->{last_msg} = $msg;
  if ($length > 0) {
    return _error("read of body failed: $!" ) 
      unless CORE::read($sock,$body,$length);
    $body =~ s/\0*$// if defined($strip_null) && $strip_null;
    return ($msg,$body);
  } else {
    return $msg;
  }
}

1;

__END__