Commit | Line | Data |
774d564b |
1 | # IO::Socket.pm |
8add82fc |
2 | # |
774d564b |
3 | # Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights |
4 | # reserved. This program is free software; you can redistribute it and/or |
5 | # modify it under the same terms as Perl itself. |
8add82fc |
6 | |
7 | package IO::Socket; |
8 | |
9 | =head1 NAME |
10 | |
27d4819a |
11 | IO::Socket - Object interface to socket communications |
8add82fc |
12 | |
13 | =head1 SYNOPSIS |
14 | |
15 | use IO::Socket; |
16 | |
17 | =head1 DESCRIPTION |
18 | |
19 | C<IO::Socket> provides an object interface to creating and using sockets. It |
20 | is built upon the L<IO::Handle> interface and inherits all the methods defined |
21 | by L<IO::Handle>. |
22 | |
23 | C<IO::Socket> only defines methods for those operations which are common to all |
24 | types of socket. Operations which are specified to a socket in a particular |
25 | domain have methods defined in sub classes of C<IO::Socket> |
26 | |
7a4c00b4 |
27 | C<IO::Socket> will export all functions (and constants) defined by L<Socket>. |
28 | |
27d4819a |
29 | =head1 CONSTRUCTOR |
30 | |
31 | =over 4 |
32 | |
33 | =item new ( [ARGS] ) |
34 | |
7a4c00b4 |
35 | Creates a C<IO::Socket>, which is a reference to a |
27d4819a |
36 | newly created symbol (see the C<Symbol> package). C<new> |
37 | optionally takes arguments, these arguments are in key-value pairs. |
38 | C<new> only looks for one key C<Domain> which tells new which domain |
39 | the socket it will be. All other arguments will be passed to the |
40 | configuration method of the package for that domain, See below. |
41 | |
42 | =back |
43 | |
44 | =head1 METHODS |
45 | |
8add82fc |
46 | See L<perlfunc> for complete descriptions of each of the following |
47 | supported C<IO::Seekable> methods, which are just front ends for the |
48 | corresponding built-in functions: |
49 | |
50 | socket |
51 | socketpair |
52 | bind |
53 | listen |
54 | accept |
55 | send |
56 | recv |
57 | peername (getpeername) |
58 | sockname (getsockname) |
59 | |
60 | Some methods take slightly different arguments to those defined in L<perlfunc> |
61 | in attempt to make the interface more flexible. These are |
62 | |
27d4819a |
63 | =over 4 |
64 | |
8add82fc |
65 | =item accept([PKG]) |
66 | |
67 | perform the system call C<accept> on the socket and return a new object. The |
68 | new object will be created in the same class as the listen socket, unless |
69 | C<PKG> is specified. This object can be used to communicate with the client |
70 | that was trying to connect. In a scalar context the new socket is returned, |
71 | or undef upon failure. In an array context a two-element array is returned |
72 | containing the new socket and the peer address, the list will |
73 | be empty upon failure. |
74 | |
75 | Additional methods that are provided are |
76 | |
77 | =item timeout([VAL]) |
78 | |
79 | Set or get the timeout value associated with this socket. If called without |
80 | any arguments then the current setting is returned. If called with an argument |
81 | the current setting is changed and the previous value returned. |
82 | |
83 | =item sockopt(OPT [, VAL]) |
84 | |
85 | Unified method to both set and get options in the SOL_SOCKET level. If called |
27d4819a |
86 | with one argument then getsockopt is called, otherwise setsockopt is called. |
87 | |
88 | =item sockdomain |
89 | |
7a4c00b4 |
90 | Returns the numerical number for the socket domain type. For example, for |
27d4819a |
91 | a AF_INET socket the value of &AF_INET will be returned. |
92 | |
93 | =item socktype |
94 | |
7a4c00b4 |
95 | Returns the numerical number for the socket type. For example, for |
27d4819a |
96 | a SOCK_STREAM socket the value of &SOCK_STREAM will be returned. |
97 | |
98 | =item protocol |
99 | |
100 | Returns the numerical number for the protocol being used on the socket, if |
101 | known. If the protocol is unknown, as with an AF_UNIX socket, zero |
102 | is returned. |
103 | |
104 | =back |
8add82fc |
105 | |
106 | =cut |
107 | |
108 | |
109 | require 5.000; |
110 | |
111 | use Config; |
112 | use IO::Handle; |
113 | use Socket 1.3; |
114 | use Carp; |
115 | use strict; |
7a4c00b4 |
116 | use vars qw(@ISA $VERSION); |
8add82fc |
117 | use Exporter; |
118 | |
119 | @ISA = qw(IO::Handle); |
120 | |
774d564b |
121 | $VERSION = "1.16"; |
8add82fc |
122 | |
123 | sub import { |
124 | my $pkg = shift; |
125 | my $callpkg = caller; |
126 | Exporter::export 'Socket', $callpkg, @_; |
127 | } |
128 | |
129 | sub new { |
130 | my($class,%arg) = @_; |
131 | my $fh = $class->SUPER::new(); |
132 | |
133 | ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout}; |
134 | |
135 | return scalar(%arg) ? $fh->configure(\%arg) |
136 | : $fh; |
137 | } |
138 | |
27d4819a |
139 | my @domain2pkg = (); |
140 | |
141 | sub register_domain { |
142 | my($p,$d) = @_; |
774d564b |
143 | $domain2pkg[$d] = $p; |
27d4819a |
144 | } |
145 | |
8add82fc |
146 | sub configure { |
27d4819a |
147 | my($fh,$arg) = @_; |
148 | my $domain = delete $arg->{Domain}; |
149 | |
150 | croak 'IO::Socket: Cannot configure a generic socket' |
151 | unless defined $domain; |
152 | |
774d564b |
153 | croak "IO::Socket: Unsupported socket domain" |
154 | unless defined $domain2pkg[$domain]; |
27d4819a |
155 | |
7a4c00b4 |
156 | croak "IO::Socket: Cannot configure socket in domain '$domain'" |
157 | unless ref($fh) eq "IO::Socket"; |
27d4819a |
158 | |
774d564b |
159 | bless($fh, $domain2pkg[$domain]); |
7a4c00b4 |
160 | $fh->configure; |
8add82fc |
161 | } |
162 | |
163 | sub socket { |
164 | @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)'; |
165 | my($fh,$domain,$type,$protocol) = @_; |
166 | |
167 | socket($fh,$domain,$type,$protocol) or |
168 | return undef; |
169 | |
774d564b |
170 | ${*$fh}{'io_socket_domain'} = $domain; |
171 | ${*$fh}{'io_socket_type'} = $type; |
172 | ${*$fh}{'io_socket_proto'} = $protocol; |
173 | |
8add82fc |
174 | $fh; |
175 | } |
176 | |
177 | sub socketpair { |
178 | @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)'; |
179 | my($class,$domain,$type,$protocol) = @_; |
180 | my $fh1 = $class->new(); |
181 | my $fh2 = $class->new(); |
182 | |
183 | socketpair($fh1,$fh1,$domain,$type,$protocol) or |
184 | return (); |
185 | |
27d4819a |
186 | ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type; |
187 | ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol; |
8add82fc |
188 | |
189 | ($fh1,$fh2); |
190 | } |
191 | |
192 | sub connect { |
193 | @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)'; |
194 | my $fh = shift; |
195 | my $addr = @_ == 1 ? shift : sockaddr_in(@_); |
196 | my $timeout = ${*$fh}{'io_socket_timeout'}; |
197 | local($SIG{ALRM}) = $timeout ? sub { undef $fh; } |
198 | : $SIG{ALRM} || 'DEFAULT'; |
199 | |
760ac839 |
200 | eval { |
8add82fc |
201 | croak 'connect: Bad address' |
202 | if(@_ == 2 && !defined $_[1]); |
203 | |
204 | if($timeout) { |
205 | defined $Config{d_alarm} && defined alarm($timeout) or |
206 | $timeout = 0; |
207 | } |
208 | |
760ac839 |
209 | my $ok = connect($fh, $addr); |
8add82fc |
210 | |
211 | alarm(0) |
212 | if($timeout); |
213 | |
760ac839 |
214 | croak "connect: timeout" |
215 | unless defined $fh; |
8add82fc |
216 | |
760ac839 |
217 | undef $fh unless $ok; |
8add82fc |
218 | }; |
760ac839 |
219 | |
8add82fc |
220 | $fh; |
221 | } |
222 | |
223 | sub bind { |
224 | @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)'; |
225 | my $fh = shift; |
226 | my $addr = @_ == 1 ? shift : sockaddr_in(@_); |
227 | |
228 | return bind($fh, $addr) ? $fh |
229 | : undef; |
230 | } |
231 | |
232 | sub listen { |
233 | @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])'; |
234 | my($fh,$queue) = @_; |
235 | $queue = 5 |
236 | unless $queue && $queue > 0; |
237 | |
238 | return listen($fh, $queue) ? $fh |
239 | : undef; |
240 | } |
241 | |
242 | sub accept { |
243 | @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])'; |
244 | my $fh = shift; |
245 | my $pkg = shift || $fh; |
246 | my $timeout = ${*$fh}{'io_socket_timeout'}; |
247 | my $new = $pkg->new(Timeout => $timeout); |
248 | my $peer = undef; |
249 | |
250 | eval { |
251 | if($timeout) { |
252 | my $fdset = ""; |
253 | vec($fdset, $fh->fileno,1) = 1; |
254 | croak "accept: timeout" |
255 | unless select($fdset,undef,undef,$timeout); |
256 | } |
257 | $peer = accept($new,$fh); |
258 | }; |
259 | |
260 | return wantarray ? defined $peer ? ($new, $peer) |
261 | : () |
262 | : defined $peer ? $new |
263 | : undef; |
264 | } |
265 | |
266 | sub sockname { |
267 | @_ == 1 or croak 'usage: $fh->sockname()'; |
268 | getsockname($_[0]); |
269 | } |
270 | |
271 | sub peername { |
272 | @_ == 1 or croak 'usage: $fh->peername()'; |
273 | my($fh) = @_; |
274 | getpeername($fh) |
275 | || ${*$fh}{'io_socket_peername'} |
276 | || undef; |
277 | } |
278 | |
279 | sub send { |
280 | @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])'; |
281 | my $fh = $_[0]; |
282 | my $flags = $_[2] || 0; |
283 | my $peer = $_[3] || $fh->peername; |
284 | |
285 | croak 'send: Cannot determine peer address' |
286 | unless($peer); |
287 | |
27d4819a |
288 | my $r = defined(getpeername($fh)) |
289 | ? send($fh, $_[1], $flags) |
290 | : send($fh, $_[1], $flags, $peer); |
8add82fc |
291 | |
292 | # remember who we send to, if it was sucessful |
293 | ${*$fh}{'io_socket_peername'} = $peer |
294 | if(@_ == 4 && defined $r); |
295 | |
296 | $r; |
297 | } |
298 | |
299 | sub recv { |
300 | @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])'; |
301 | my $sock = $_[0]; |
302 | my $len = $_[2]; |
303 | my $flags = $_[3] || 0; |
304 | |
305 | # remember who we recv'd from |
306 | ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags); |
307 | } |
308 | |
309 | |
310 | sub setsockopt { |
311 | @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)'; |
312 | setsockopt($_[0],$_[1],$_[2],$_[3]); |
313 | } |
314 | |
315 | my $intsize = length(pack("i",0)); |
316 | |
317 | sub getsockopt { |
318 | @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)'; |
319 | my $r = getsockopt($_[0],$_[1],$_[2]); |
320 | # Just a guess |
321 | $r = unpack("i", $r) |
322 | if(defined $r && length($r) == $intsize); |
323 | $r; |
324 | } |
325 | |
326 | sub sockopt { |
327 | my $fh = shift; |
328 | @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_) |
329 | : $fh->setsockopt(SOL_SOCKET,@_); |
330 | } |
331 | |
332 | sub timeout { |
333 | @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])'; |
334 | my($fh,$val) = @_; |
335 | my $r = ${*$fh}{'io_socket_timeout'} || undef; |
336 | |
337 | ${*$fh}{'io_socket_timeout'} = 0 + $val |
338 | if(@_ == 2); |
339 | |
340 | $r; |
341 | } |
342 | |
27d4819a |
343 | sub sockdomain { |
344 | @_ == 1 or croak 'usage: $fh->sockdomain()'; |
345 | my $fh = shift; |
774d564b |
346 | ${*$fh}{'io_socket_domain'}; |
27d4819a |
347 | } |
348 | |
8add82fc |
349 | sub socktype { |
27d4819a |
350 | @_ == 1 or croak 'usage: $fh->socktype()'; |
351 | my $fh = shift; |
352 | ${*$fh}{'io_socket_type'} |
8add82fc |
353 | } |
354 | |
27d4819a |
355 | sub protocol { |
356 | @_ == 1 or croak 'usage: $fh->protocol()'; |
357 | my($fh) = @_; |
358 | ${*$fh}{'io_socket_protocol'}; |
359 | } |
360 | |
8add82fc |
361 | =head1 SUB-CLASSES |
362 | |
363 | =cut |
364 | |
365 | ## |
366 | ## AF_INET |
367 | ## |
368 | |
369 | package IO::Socket::INET; |
370 | |
371 | use strict; |
7a4c00b4 |
372 | use vars qw(@ISA); |
8add82fc |
373 | use Socket; |
374 | use Carp; |
375 | use Exporter; |
376 | |
377 | @ISA = qw(IO::Socket); |
378 | |
27d4819a |
379 | IO::Socket::INET->register_domain( AF_INET ); |
380 | |
8add82fc |
381 | my %socket_type = ( tcp => SOCK_STREAM, |
382 | udp => SOCK_DGRAM, |
383 | ); |
384 | |
385 | =head2 IO::Socket::INET |
386 | |
387 | C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket |
388 | and some related methods. The constructor can take the following options |
389 | |
7a4c00b4 |
390 | PeerAddr Remote host address <hostname>[:<port>] |
391 | PeerPort Remote port or service <service>[(<no>)] | <no> |
392 | LocalAddr Local host bind address hostname[:port] |
393 | LocalPort Local host bind port <service>[(<no>)] | <no> |
394 | Proto Protocol name "tcp" | "udp" | ... |
395 | Type Socket type SOCK_STREAM | SOCK_DGRAM | ... |
8add82fc |
396 | Listen Queue size for listen |
7a4c00b4 |
397 | Reuse Set SO_REUSEADDR before binding |
8add82fc |
398 | Timeout Timeout value for various operations |
399 | |
27d4819a |
400 | |
7a4c00b4 |
401 | If C<Listen> is defined then a listen socket is created, else if the |
402 | socket type, which is derived from the protocol, is SOCK_STREAM then |
403 | connect() is called. |
404 | |
405 | The C<PeerAddr> can be a hostname or the IP-address on the |
406 | "xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic |
407 | service name. The service name might be followed by a number in |
408 | parenthesis which is used if the service is not known by the system. |
409 | The C<PeerPort> specification can also be embedded in the C<PeerAddr> |
410 | by preceding it with a ":". |
411 | |
412 | Only one of C<Type> or C<Proto> needs to be specified, one will be |
413 | assumed from the other. If you specify a symbolic C<PeerPort> port, |
414 | then the constructor will try to derive C<Type> and C<Proto> from |
415 | the service name. |
8add82fc |
416 | |
7a4c00b4 |
417 | Examples: |
418 | |
419 | $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org', |
420 | PeerPort => http(80), |
421 | Proto => 'tcp'); |
422 | |
423 | $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)'); |
424 | |
425 | $sock = IO::Socket::INET->new(Listen => 5, |
426 | LocalAddr => 'localhost', |
427 | LocalPort => 9000, |
428 | Proto => 'tcp'); |
8add82fc |
429 | |
430 | =head2 METHODS |
431 | |
27d4819a |
432 | =over 4 |
433 | |
434 | =item sockaddr () |
8add82fc |
435 | |
436 | Return the address part of the sockaddr structure for the socket |
437 | |
27d4819a |
438 | =item sockport () |
8add82fc |
439 | |
440 | Return the port number that the socket is using on the local host |
441 | |
27d4819a |
442 | =item sockhost () |
8add82fc |
443 | |
444 | Return the address part of the sockaddr structure for the socket in a |
445 | text form xx.xx.xx.xx |
446 | |
27d4819a |
447 | =item peeraddr () |
448 | |
449 | Return the address part of the sockaddr structure for the socket on |
450 | the peer host |
451 | |
452 | =item peerport () |
453 | |
454 | Return the port number for the socket on the peer host. |
8add82fc |
455 | |
27d4819a |
456 | =item peerhost () |
457 | |
458 | Return the address part of the sockaddr structure for the socket on the |
459 | peer host in a text form xx.xx.xx.xx |
460 | |
461 | =back |
8add82fc |
462 | |
463 | =cut |
464 | |
8add82fc |
465 | sub _sock_info { |
466 | my($addr,$port,$proto) = @_; |
467 | my @proto = (); |
468 | my @serv = (); |
469 | |
470 | $port = $1 |
471 | if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,); |
472 | |
473 | if(defined $proto) { |
474 | @proto = $proto =~ m,\D, ? getprotobyname($proto) |
475 | : getprotobynumber($proto); |
476 | |
477 | $proto = $proto[2] || undef; |
478 | } |
479 | |
480 | if(defined $port) { |
481 | $port =~ s,\((\d+)\)$,,; |
482 | |
483 | my $defport = $1 || undef; |
484 | my $pnum = ($port =~ m,^(\d+)$,)[0]; |
485 | |
486 | @serv= getservbyname($port, $proto[0] || "") |
487 | if($port =~ m,\D,); |
488 | |
489 | $port = $pnum || $serv[2] || $defport || undef; |
490 | |
491 | $proto = (getprotobyname($serv[3]))[2] || undef |
492 | if @serv && !$proto; |
493 | } |
494 | |
495 | return ($addr || undef, |
496 | $port || undef, |
497 | $proto || undef |
498 | ); |
499 | } |
500 | |
27d4819a |
501 | sub _error { |
502 | my $fh = shift; |
7a4c00b4 |
503 | $@ = join("",ref($fh),": ",@_); |
504 | carp $@ if $^W; |
27d4819a |
505 | close($fh) |
506 | if(defined fileno($fh)); |
507 | return undef; |
508 | } |
509 | |
8add82fc |
510 | sub configure { |
511 | my($fh,$arg) = @_; |
512 | my($lport,$rport,$laddr,$raddr,$proto,$type); |
513 | |
514 | |
515 | ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr}, |
516 | $arg->{LocalPort}, |
517 | $arg->{Proto}); |
518 | |
519 | $laddr = defined $laddr ? inet_aton($laddr) |
520 | : INADDR_ANY; |
521 | |
27d4819a |
522 | return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'") |
523 | unless(defined $laddr); |
524 | |
8add82fc |
525 | unless(exists $arg->{Listen}) { |
526 | ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr}, |
527 | $arg->{PeerPort}, |
528 | $proto); |
529 | } |
530 | |
27d4819a |
531 | if(defined $raddr) { |
532 | $raddr = inet_aton($raddr); |
533 | return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'") |
534 | unless(defined $raddr); |
535 | } |
536 | |
537 | return _error($fh,'Cannot determine protocol') |
8add82fc |
538 | unless($proto); |
539 | |
540 | my $pname = (getprotobynumber($proto))[0]; |
541 | $type = $arg->{Type} || $socket_type{$pname}; |
542 | |
543 | $fh->socket(AF_INET, $type, $proto) or |
7a4c00b4 |
544 | return _error($fh,"$!"); |
545 | |
546 | if ($arg->{Reuse}) { |
547 | $fh->sockopt(SO_REUSEADDR,1) or |
548 | return _error($fh); |
549 | } |
8add82fc |
550 | |
551 | $fh->bind($lport || 0, $laddr) or |
7a4c00b4 |
552 | return _error($fh,"$!"); |
8add82fc |
553 | |
554 | if(exists $arg->{Listen}) { |
555 | $fh->listen($arg->{Listen} || 5) or |
7a4c00b4 |
556 | return _error($fh,"$!"); |
8add82fc |
557 | } |
558 | else { |
27d4819a |
559 | return _error($fh,'Cannot determine remote port') |
8add82fc |
560 | unless($rport || $type == SOCK_DGRAM); |
561 | |
562 | if($type == SOCK_STREAM || defined $raddr) { |
27d4819a |
563 | return _error($fh,'Bad peer address') |
564 | unless(defined $raddr); |
8add82fc |
565 | |
27d4819a |
566 | $fh->connect($rport,$raddr) or |
7a4c00b4 |
567 | return _error($fh,"$!"); |
8add82fc |
568 | } |
569 | } |
570 | |
571 | $fh; |
572 | } |
573 | |
574 | sub sockaddr { |
575 | @_ == 1 or croak 'usage: $fh->sockaddr()'; |
576 | my($fh) = @_; |
577 | (sockaddr_in($fh->sockname))[1]; |
578 | } |
579 | |
580 | sub sockport { |
581 | @_ == 1 or croak 'usage: $fh->sockport()'; |
582 | my($fh) = @_; |
583 | (sockaddr_in($fh->sockname))[0]; |
584 | } |
585 | |
586 | sub sockhost { |
587 | @_ == 1 or croak 'usage: $fh->sockhost()'; |
588 | my($fh) = @_; |
589 | inet_ntoa($fh->sockaddr); |
590 | } |
591 | |
592 | sub peeraddr { |
593 | @_ == 1 or croak 'usage: $fh->peeraddr()'; |
594 | my($fh) = @_; |
595 | (sockaddr_in($fh->peername))[1]; |
596 | } |
597 | |
598 | sub peerport { |
599 | @_ == 1 or croak 'usage: $fh->peerport()'; |
600 | my($fh) = @_; |
601 | (sockaddr_in($fh->peername))[0]; |
602 | } |
603 | |
604 | sub peerhost { |
605 | @_ == 1 or croak 'usage: $fh->peerhost()'; |
606 | my($fh) = @_; |
607 | inet_ntoa($fh->peeraddr); |
608 | } |
609 | |
610 | ## |
611 | ## AF_UNIX |
612 | ## |
613 | |
614 | package IO::Socket::UNIX; |
615 | |
616 | use strict; |
617 | use vars qw(@ISA $VERSION); |
618 | use Socket; |
619 | use Carp; |
620 | use Exporter; |
621 | |
622 | @ISA = qw(IO::Socket); |
623 | |
27d4819a |
624 | IO::Socket::UNIX->register_domain( AF_UNIX ); |
625 | |
8add82fc |
626 | =head2 IO::Socket::UNIX |
627 | |
628 | C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket |
629 | and some related methods. The constructor can take the following options |
630 | |
631 | Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM) |
632 | Local Path to local fifo |
633 | Peer Path to peer fifo |
634 | Listen Create a listen socket |
635 | |
636 | =head2 METHODS |
637 | |
27d4819a |
638 | =over 4 |
639 | |
8add82fc |
640 | =item hostpath() |
641 | |
7a4c00b4 |
642 | Returns the pathname to the fifo at the local end |
8add82fc |
643 | |
644 | =item peerpath() |
645 | |
7a4c00b4 |
646 | Returns the pathanme to the fifo at the peer end |
27d4819a |
647 | |
648 | =back |
8add82fc |
649 | |
650 | =cut |
651 | |
652 | sub configure { |
653 | my($fh,$arg) = @_; |
654 | my($bport,$cport); |
655 | |
656 | my $type = $arg->{Type} || SOCK_STREAM; |
657 | |
658 | $fh->socket(AF_UNIX, $type, 0) or |
659 | return undef; |
660 | |
661 | if(exists $arg->{Local}) { |
662 | my $addr = sockaddr_un($arg->{Local}); |
663 | $fh->bind($addr) or |
664 | return undef; |
665 | } |
666 | if(exists $arg->{Listen}) { |
667 | $fh->listen($arg->{Listen} || 5) or |
668 | return undef; |
669 | } |
670 | elsif(exists $arg->{Peer}) { |
671 | my $addr = sockaddr_un($arg->{Peer}); |
672 | $fh->connect($addr) or |
673 | return undef; |
674 | } |
675 | |
676 | $fh; |
677 | } |
678 | |
679 | sub hostpath { |
680 | @_ == 1 or croak 'usage: $fh->hostpath()'; |
27d4819a |
681 | my $n = $_[0]->sockname || return undef; |
27d4819a |
682 | (sockaddr_un($n))[0]; |
8add82fc |
683 | } |
684 | |
685 | sub peerpath { |
686 | @_ == 1 or croak 'usage: $fh->peerpath()'; |
27d4819a |
687 | my $n = $_[0]->peername || return undef; |
27d4819a |
688 | (sockaddr_un($n))[0]; |
8add82fc |
689 | } |
690 | |
7a4c00b4 |
691 | =head1 SEE ALSO |
8add82fc |
692 | |
7a4c00b4 |
693 | L<Socket>, L<IO::Handle> |
8add82fc |
694 | |
7a4c00b4 |
695 | =head1 AUTHOR |
8add82fc |
696 | |
7a4c00b4 |
697 | Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt> |
760ac839 |
698 | |
8add82fc |
699 | =head1 COPYRIGHT |
700 | |
774d564b |
701 | Copyright (c) 1996 Graham Barr. All rights reserved. This program is free |
8add82fc |
702 | software; you can redistribute it and/or modify it under the same terms |
703 | as Perl itself. |
704 | |
705 | =cut |
706 | |
707 | 1; # Keep require happy |