This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.000
[perl5.git] / pod / perlipc.pod
1 =head1 NAME
2
3 perlipc - Perl interprocess communication
4
5 =head1 DESCRIPTION
6
7 The IPC facilities of Perl are built on the Berkeley socket mechanism.
8 If you don't have sockets, you can ignore this section.  The calls have
9 the same names as the corresponding system calls, but the arguments
10 tend to differ, for two reasons.  First, Perl file handles work
11 differently than C file descriptors.  Second, Perl already knows the
12 length of its strings, so you don't need to pass that information.
13
14 =head2 Client/Server Communication
15
16 Here's a sample TCP client.
17
18     ($them,$port) = @ARGV;
19     $port = 2345 unless $port;
20     $them = 'localhost' unless $them;
21
22     $SIG{'INT'} = 'dokill';
23     sub dokill { kill 9,$child if $child; }
24
25     use Socket;
26
27     $sockaddr = 'S n a4 x8';
28     chop($hostname = `hostname`);
29
30     ($name, $aliases, $proto) = getprotobyname('tcp');
31     ($name, $aliases, $port) = getservbyname($port, 'tcp')
32         unless $port =~ /^\d+$/;
33     ($name, $aliases, $type, $len, $thisaddr) =
34                     gethostbyname($hostname);
35     ($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
36
37     $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
38     $that = pack($sockaddr, &AF_INET, $port, $thataddr);
39
40     socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
41     bind(S, $this) || die "bind: $!";
42     connect(S, $that) || die "connect: $!";
43
44     select(S); $| = 1; select(stdout);
45
46     if ($child = fork) {
47         while (<>) {
48             print S;
49         }
50         sleep 3;
51         do dokill();
52     }
53     else {
54         while (<S>) {
55             print;
56         }
57     }
58
59 And here's a server:
60
61     ($port) = @ARGV;
62     $port = 2345 unless $port;
63
64     use Socket;
65
66     $sockaddr = 'S n a4 x8';
67
68     ($name, $aliases, $proto) = getprotobyname('tcp');
69     ($name, $aliases, $port) = getservbyname($port, 'tcp')
70         unless $port =~ /^\d+$/;
71
72     $this = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");
73
74     select(NS); $| = 1; select(stdout);
75
76     socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
77     bind(S, $this) || die "bind: $!";
78     listen(S, 5) || die "connect: $!";
79
80     select(S); $| = 1; select(stdout);
81
82     for (;;) {
83         print "Listening again\n";
84         ($addr = accept(NS,S)) || die $!;
85         print "accept ok\n";
86
87         ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
88         @inetaddr = unpack('C4',$inetaddr);
89         print "$af $port @inetaddr\n";
90
91         while (<NS>) {
92             print;
93             print NS;
94         }
95     }
96
97 =head2 SysV IPC
98
99 Here's a small example showing shared memory usage:
100
101     $IPC_PRIVATE = 0;
102     $IPC_RMID = 0;
103     $size = 2000;
104     $key = shmget($IPC_PRIVATE, $size , 0777 );
105     die if !defined($key);
106
107     $message = "Message #1";
108     shmwrite($key, $message, 0, 60 ) || die "$!";
109     shmread($key,$buff,0,60) || die "$!";
110
111     print $buff,"\n";
112
113     print "deleting $key\n";
114     shmctl($key ,$IPC_RMID, 0) || die "$!";
115
116 Here's an example of a semaphore:
117
118     $IPC_KEY = 1234;
119     $IPC_RMID = 0;
120     $IPC_CREATE = 0001000;
121     $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
122     die if !defined($key);
123     print "$key\n";
124
125 Put this code in a separate file to be run in more that one process
126 Call the file F<take>:
127
128     # create a semaphore
129
130     $IPC_KEY = 1234;
131     $key = semget($IPC_KEY,  0 , 0 );
132     die if !defined($key);
133
134     $semnum = 0;
135     $semflag = 0;
136
137     # 'take' semaphore
138     # wait for semaphore to be zero
139     $semop = 0;
140     $opstring1 = pack("sss", $semnum, $semop, $semflag);
141
142     # Increment the semaphore count
143     $semop = 1;
144     $opstring2 = pack("sss", $semnum, $semop,  $semflag);
145     $opstring = $opstring1 . $opstring2;
146
147     semop($key,$opstring) || die "$!";
148
149 Put this code in a separate file to be run in more that one process
150 Call this file F<give>:
151
152     #'give' the semaphore
153     # run this in the original process and you will see
154     # that the second process continues
155
156     $IPC_KEY = 1234;
157     $key = semget($IPC_KEY, 0, 0);
158     die if !defined($key);
159
160     $semnum = 0;
161     $semflag = 0;
162
163     # Decrement the semaphore count
164     $semop = -1;
165     $opstring = pack("sss", $semnum, $semop, $semflag);
166
167     semop($key,$opstring) || die "$!";
168