Commit | Line | Data |
---|---|---|
a0d0e21e LW |
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 | ||
748a9306 LW |
37 | $this = pack($sockaddr, AF_INET, 0, $thisaddr); |
38 | $that = pack($sockaddr, AF_INET, $port, $thataddr); | |
a0d0e21e | 39 | |
748a9306 | 40 | socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; |
a0d0e21e LW |
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 | ||
748a9306 | 72 | $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0"); |
a0d0e21e LW |
73 | |
74 | select(NS); $| = 1; select(stdout); | |
75 | ||
748a9306 | 76 | socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; |
a0d0e21e LW |
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 |