perl实现HttpServer

  1. perl实现HttpServer
    1. 目标
    2. code:
    3. 问题:

perl实现HttpServer

目标

  • 请求常用静态资源,正确响应这些文件
  • 解析目录文件,显示文件及目录信息
  • 默认响应index.html
  • 解析.do,响应data目录下的同名json(特殊)
  • 端口、目录可配置

    code:

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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
#!/usr/bin/env perl
#tcp_socket_server.pl

use warnings;
use Socket;
use Cwd;
use URI;
use POSIX qw(strftime);
use File::Spec;
use POSIX ":sys_wait_h";
my $port = 8080; #port
my $root = getcwd;
my %request; #save headers
my $mime;
my %mime = (
"text" => "text/plain",
"html" => "text/html",
"css" => "text/css",
"js" => "application/javascript",
"json" => "application/json"
);
my $quit = 0;
$SIG{INT} = $SIG{TERM} = sub {
$quit++;
exit(0);
};

sub REAPER {
while ( ( my $pid = waitpid( -1, WNOHANG ) ) > 0 ) {
print "SIGCHLD pid $pid\n";
}
}
$SIG{CHLD} = \&REAPER;

sub main {
my $argstr = join( " ", @ARGV ); #server -p8080 -r /home/toor
$argstr = " $argstr ";
if ( $argstr =~ /\s-h\s/ ) {
print "usage:\n";
print " perl server.pl -p8080 -r /home/toor/webapp\n";
exit(0);
}
if ( $argstr =~ /\s-p\s*(\d{2,5})\s/ ) {
$port = $1;
}
if ( $argstr =~ /\s-r\s?(\S+)\s/ ) {
$root = $1;
}
socket( server_socket, AF_INET, SOCK_STREAM, getprotobyname('tcp') )
or die "Socket $!\n";
setsockopt( server_socket, SOL_SOCKET, SO_REUSEADDR, 1 )
or die "Can't set SO_REUSADDR: $!";
my $my_addr = sockaddr_in( $port, INADDR_ANY );

bind( server_socket, $my_addr ) or die "Bind $!\n";

listen( server_socket, 5 ) || die "Listen $!\n";

print "http server start in http://127.0.0.1:/$port\n";
print "http server work in path $root\n";
while ( !$quit ) {
accept( client_socket, server_socket ) || do {

# try again if accept() returned because a signal was received
next if $!{EINTR};
die "accept: $!";
};
defined( $pid = fork ) || die "Fork: $!\n";
if ( $pid == 0 ) {
&accept_request(client_socket);
exit(0);
}
else {
close(client_socket);
}
}

}

sub accept_request { # handle a request
# my $socket = shift;
&parse_headers(client_socket); #parse
my $uri = $request{'uri'};
if ( !$uri ) {
close(client_socket);
return;
}
$now = strftime( "%Y-%m-%d %H:%M:%S", localtime )
; #my $now = `date`; # $now =~ s/\n//;
print "$now $request{'method'} $uri\n";
$uri =~ s/(\?.*)// if ( $uri =~ /\?.*/ );
if ( $uri =~ /\w+\.html$/ ) {
$mime = $mime{'html'};
}
elsif ( $uri =~ /\w+\.css$/ ) {
$mime = $mime{"css"};
}
elsif ( $uri =~ /\w+\.js$/ ) {
$mime = $mime{"js"};
}
elsif ( $uri =~ /\w+\.json$/ ) {
$mime = $mime{"json"};
}
elsif ( $uri =~ /\w+\.svg$/ ) {
$mime = "image/svg+xml";
}
elsif ( $uri =~ /\w+\.do$/ ) {
$mime = $mime{"json"};
my $prefix;
my $suffix = $uri;
my $refer = $request{'$Referer'};
if ( $refer && $refer =~ /htmls(\/.*\/)\w+\.html/ ) {
$prefix = "/data$1";
$suffix =~ s/\/(\w+)\.do/$1.json/;
$uri = "$prefix$suffix";
}
else {
$suffix =~ s/\/(\w[\w\d\.]+)\.do/$1.json/;
$uri = "/data/$suffix";

# resp_error( 500, "Bad Request" );
# close(client_socket);
# exit(1);
}
}
else {
$mime = "text/html";
}
my $filename = File::Spec->catfile( $root, $uri );
if ( -e -f $filename ) {
send_success($filename);
}
elsif ( -e -d $filename ) {
if ( -e -f "$filename/index.html" ) {
send_success("$filename/index.html");
}
else {
resp_filelist($filename);
}
}
else {
resp_error( 404, "Not Found" );
}
close(client_socket);
}

sub parse_headers {

# my ($socket) = @_; #client socket
my $content = "";
while (1) {
my $buffer;
my $flag = sysread( client_socket, $buffer, 1024 );
$content .= $buffer;
last if ( $flag < 1024 );
}
if ( $content =~ m/^(.*)\s(\/.*)\s(HTTP\/\d\.\d)/ ) {
$request{'method'} = $1;
$request{'uri'} = URI::Escape::uri_unescape($2);
$request{'protocol'} = $3;
}
my @header = split( /\n/, $content );
foreach (@header) {
if (/^([^()<>\@,;:\\"\/\[\]?={} \t]+):\s*(.*)/i) {
$request{$1} = $2;
}
}
}

sub resp_headers {
print client_socket "HTTP/1.0 200 OK\n";
print client_socket "Content-Type: $mime;charset: utf-8\n";
print client_socket "Date: $now\n";
print client_socket "Server: xyserver\n";
print client_socket "\n";
}

sub resp_filelist {
my ($directory) = shift;
opendir( DIR, $directory ) or die "cannot open $directory:$!";
resp_headers();
( my $shortdir = $directory ) =~ s{$root}{};
$shortdir =~ s/\/\//\//g;
print client_socket
"<html><head><meta http-equiv='Content-Type' content='text/html; charset=utf-8' /> <title>Index of ./</title></head><body><h1>Directory:$shortdir</h1><table border='0'><tbody>";
print client_socket
"<tr><td><a href='../'>Parent Directory</a></td><td></td><td></td></tr>";
foreach ( sort readdir DIR ) {
next if (/^\./);
my @info = stat("$directory/$_");
( my $href = "$shortdir/$_" ) =~ s/\/\//\//g;
$href = "$href/" if ( -d "$directory/$_" );
my $size = $info[7];
my $mtime = strftime( "%Y-%m-%d %H:%M:%S", localtime( $info[9] ) );
$href =~ s/\/\//\//g;
print client_socket
"<tr><td><a href='$href'>$_</a></td><td style='text-align:right'>$size bytes</td><td> $mtime</td></tr>";
}
closedir DIR;
print client_socket "</tbody></table></body></html>";
}

sub resp_error { #status, message
my ( $status, $error ) = @_;
print client_socket "HTTP/1.0 $status $error\n";
print client_socket "Content-Type: text/html;charset: utf-8\n";
print client_socket "Date: $now\n";
print client_socket "Server: xyserver\n";
print client_socket "\n";
print client_socket
"<html><head><title>Http Error</title></head><body><h2>Http Error...</h2><p>errror status:$status</p><pre>error message:$error</pre><hr><i><small>Powered by javaway</i></body></html>";
}

sub send_success {
my $filename = shift;
resp_headers();
open FILE, "<$filename"
or die "cannot open $filename:$!";
foreach (<FILE>) {
print client_socket $_;
}
}

main();

问题:

  • 阻塞式socket判断数据读完的问题?
    临时解决:假定读取的数据长度为1024的概率为0,每次读取1024字节,则读取到数据不为1024时读取完成!
  • 使用perl,fork子进程导致的僵尸进程问题?waitpid判断

转载请注明来源,欢迎对文章中的引用来源进行考证,欢迎指出任何有错误或不够清晰的表达。可以在下面评论区评论,也可以邮件至 [email protected]

文章标题:perl实现HttpServer

本文作者:xuxihai123

发布时间:2021-05-06, 04:41:13

最后更新:2021-05-06, 04:41:13

原始链接:https://www.xuxihai.com/2021/05/06/perl-httpServer/

版权声明: "署名-非商用-相同方式共享 4.0" 转载请保留原文链接及作者。

目录
×

喜欢就点赞,疼爱就打赏