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