File: client.pl

package info (click to toggle)
acedb 4.9.39+dfsg.02-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 33,796 kB
  • sloc: ansic: 256,989; perl: 2,803; cpp: 2,534; csh: 1,712; python: 862; sh: 658; makefile: 298; awk: 249; lex: 225; yacc: 221
file content (124 lines) | stat: -rw-r--r-- 2,711 bytes parent folder | download | duplicates (3)
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
#!/bin/env perl

# $Id: client.pl,v 1.2 1997/05/24 14:07:07 mieg Exp $ 
#from Programming Perl by Larry Wall and Randall Schwartz
#O'Reilly and Associates, Inc 1991
#pp 342-344
# and modified

chop ($uname = `uname`);
chop ($version = `uname -r`); $version =~ s/v//ig; # just want a number

#########################################
# edit this section if client.pl doesn't work on your computer
#
### first try uncommenting the next 3 lines if you're using perl 5
#use Socket;
#$AF_INET = &AF_INET;
#$SOCK_STREAM = &SOCK_STREAM;
###
#
### otherwise, comment out the previous section, and add 
#   values for your computer in the section below.
#   To get these values, check sys/socket.h
#   probably in /usr/include
unless ($AF_INET) { # bypassed if the 'use Socket' section works
    if (($uname =~ /IRIX/) || 
	     (($uname eq 'SunOS') && ($version >= 5))) {
	# works for IRIX64 and SOLARIS (= SunOS 5.x)
	$SOCK_STREAM = 2;
	$AF_INET = 2;
    }  else {
	# default
	# works for SunOS 4, AIX, HP, OSF1
	$SOCK_STREAM = 1;
	$AF_INET = 2;
    }
}
### don't edit past here
#################################################

print STDERR "client.pl running...\n";
($them, $port) = @ARGV;
$port = 2345 unless $port;
$them = 'localhost' unless $them;

$SIG{'INT'} = 'dokill';
sub dokill {
    kill 9,$child if $child;
}

$sockaddr = 'S n a4 x8';

chop($hostname = `hostname`);

($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port, 'tcp')
    unless $port =~ /^\d+$/;;
($name,$aliases,$type,$len,$thisaddr) =
    gethostbyname($hostname);
($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);

$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $port, $thataddr);

# Make the socket filehandle.

if (socket(S, $AF_INET, $SOCK_STREAM, $proto)) {
    print STDERR "socket ok\n";
}
else {
    die $! . "\nPerhaps \$AF_INET and \$SOCK_STREAM are not set correctly for your system;\nEdit wcripts/client.pl\n";
}

# Give the socket an address.

if (bind (S, $this)) {
   print STDERR "bind ok\n";
}
else {
    die $!;
}

# Call up the server.

if (connect(S, $that)) {
    print STDERR "connect ok\n";
}
else {
    die $!;
}

# Set socket to be command buffered.
# unbuffer!
select(S); $| = 1; select(STDOUT);
#select(S); undef $|; select(STDOUT);

# Avoid deadlock by forking.
# try switching parent and child

if($child = fork) {
    while(<S>){
	print;
#	exit if ($_ eq "201 A bientot\n");
    }
    print STDERR "client.pl done.\n";
}
else {
    while(<STDIN>){
	print S;
    }
}
# if($child = fork) {
#     while(<STDIN>){
# 	print S;
#     }
# #    sleep 100;
# #    do dokill();
# }
# else {
#     while(<S>){
# 	print;
#     }
# }