|
아래 소스는 Perl로 만든 웹서버인 HTTPi를
설치하였을 때 만들어지는 최종 소스입니다. 현재는 1.3.2 버전으로, HTTPi 사이트 가시면 다운로드 받아서 사용할 수 있습니다. 제가
생각하는 이 웹서버의 용도는 내부 네트웍에서의 시스템 관리나, 데이터 관리 등입니다. Keep-alive 기능을
지원하지 않기 때문에 많은 파일들을 다운로드 시켜야 하는 일반 웹사이트에서는 무리가 있습니다. 내부에서 사용할 때에는 이미지가 많이 들어가지
않고, root 계정으로 실행할 수 있으며, 다양한 핸들러를 직접 첨가하여 사용할 수 있으므로 훌륭한 관리툴이 될 것입니다.
하지만 제가
이것을 여기에 소개한 또 다른 이유가 있습니다.
많은 분들이 CGI를 만들지만, 웹서버의 동작에 대해서는 잘 모르는 채, 그저 짐작이나 잘
못된 지식만 가지고 만들다보니, 많은 부분에서 혼선을 빚게 됩니다. 당연히 개발기간도 늘어나겠지요. 그러나, 400줄도 되지 않는 이 훌륭한
순수 Perl로만 만든 웹서버를 분석해 보고 나면 웹서버 및 CGI에 대한 확실한 이해를 가지고 무엇이 되는 것인지, 안되는
것인지를 미리 알고 CGI를 개발할 수 있을 것입니다. Perl이 아닌 다른 언어로 CGI를 개발하시는 경우라도 마찬가지입니다. 원리를 알면
어떤 언어를 사용해도 마찬가지의 좋은 효과를 거둘 수 있을 것입니다.
이 프로그램의 저작권은 Cameron
Kaiser에게 있습니다. 이 프로그램을 사용하기 이전에 반드시 저작권에 관한 내용을 살펴보시기
바랍니다.
아래 소스는 설치를 종료한 후에 생성되며, 설치 전에는 다소 이해하기 어려운(이해하고 싶지 않은 :-) 모양을 하고 있습니다.
설치 종료시의 소스를 여기 게재한 것은 방문자들의 웹관련 프로토콜에 대한 이해를 돕기 위한 것 뿐이니 사용시에는 원본 파일을 내려받아 설치하여
사용하시기 바랍니다.
1: #!/usr/bin/perl
2: $VERSION = "1.3.1 (Demonic/FreeBSD)";
3:
4: # HTTPi Hypertext Tiny Truncated Process Implementation
5: # Copyright 1999-2001 Cameron Kaiser # All rights reserved
6: # Please read LICENSE # Do not strip this copyright message.
7:
8: %system_content_types =
9: ("html" => "text/html",
10: "htm" => "text/html",
11: "wml" => "text/vnd.wap.wml",
12: "wbmp" => "image/vnd.wap.wbmp",
13: "wbm" => "image/vnd.wap.wbmp",
14: "xbm" => "image/x-xbitmap",
15: "pdf" => "application/pdf",
16: "fdf" => "application/vnd.fdf",
17: "bin" => "application/octet-stream",
18: "class" => "application/octet-stream",
19: "jar" => "application/octet-stream",
20: "js" => "application/x-javascript",
21: "lnk" => "application/x-hyperlink",
22: "wav" => "audio/x-wav",
23: "mp3" => "audio/x-mpeg",
24: "txt" => "text/plain",
25: "gif" => "image/gif",
26: "zip" => "application/x-zip-compressed",
27: "lzh" => "application/octet-stream",
28: "lha" => "application/octet-stream",
29: "gz" => "application/x-gzip",
30: "mov" => "movie/quicktime",
31: "mpeg" => "video/mpeg",
32: "mpg" => "video/mpeg",
33: "jpeg" => "image/jpeg",
34: "jpg" => "image/jpeg");
35:
36: $logfile = "/home/perlabi/httpi/htdocs/access.log";
37: $path = "/home/perlabi/httpi/htdocs";
38: $sockaddr = 'S n a4 x8';
39:
40:
41: %content_types =
42: ("html" => "text/html",
43: "htm" => "text/html");
44: %restrictions =
45: ("/nw" => "^10\.##^Mozilla#MSIE",
46: "/status" => "####voyeur:daNrZR3TcSwD2");
47: # See documentation for interpreting this string.
48:
49: $headers = <<"EOF";
50: Server: HTTPi/$VERSION
51: MIME-Version: 1.0
52: EOF
53:
54:
55: %content_types = (%system_content_types, %content_types);
56: undef %system_content_types;
57:
58: if ($pid = fork()) { exit; }
59: $0 = "dhttpi: binding port ...";
60: $bindthis = pack($sockaddr, 2, 8088, pack('l', chr(0).chr(0).chr(0).chr(0)));
61: socket(S, 2, 1, 6);
62: setsockopt(S, 65535, 4, 1);
63: bind(S, $bindthis) || die("$0: while binding port 8088:\n\"$!\"\n");
64: listen(S, 128);
65: $0 = "dhttpi: connected and waiting ANY:8088";
66:
67: $statiosuptime = time();
68:
69: ###############################################################
70: # WHITE HATS ONLY BELOW THIS POINT -- SEE DOCUMENTATION FIRST #
71: ###############################################################
72:
73: sub sock_to_host {
74: local($sock) = getpeername(STDIN);
75:
76: return (undef, undef, undef) if (!$sock);
77: local($AFC, $port, $thataddr, $zero) = unpack($sockaddr, $sock);
78: local($ip) = join('.', unpack("C4", $thataddr));
79: return ($ip, $port, $ip);
80: }
81:
82: sub htsponse {
83: ($currentcode, $currentstring) = (@_);
84: return if (0+$httpver < 1);
85: local($what) = <<"EOF";
86: HTTP/$httpver $currentcode $currentstring
87: ${headers}Date: $rfcdate
88: EOF
89: $what =~ s/\n/\r\n/g;
90: print stdout $what;
91: &hthead("Connection: close") if (0+$httpver > 1);
92: }
93:
94: sub hthead {
95: local($header, $term) = (@_);
96: return if (0+$httpver < 1);
97: print stdout "$header\r\n" , ($term) ? "\r\n" : "";
98: }
99:
100: sub htcontent {
101: local($what, $ctype, $mode) = (@_);
102: ($contentlength) = $mode || length($what);
103: &hthead("Content-Length: $contentlength");
104: &hthead("Content-Type: $ctype", 1);
105: return if ($method eq 'HEAD' || $mode);
106: print stdout $what;
107: }
108:
109: sub log {
110: if (open(J, ">>$logfile")) {
111: local $q = $address . (($variables) ? "?$variables" : "");
112: $contentlength += 0;
113: $contentlength = 0 if ($method eq 'HEAD');
114: local ($hostname, $port, $ip) = &sock_to_host();
115: $hostname = $hostname || "-";
116: $httpuser = $httpuser || "-";
117: print J qq!$hostname - $httpuser [$date] "$method $q HTTP/$httpver"!,
118: qq! $currentcode $contentlength "$httpref" "$httpua"\n!;
119:
120: close(J); }
121: }
122:
123:
124: sub bye { exit; }
125:
126: sub dead {
127: &htsponse(500, "Server Error");
128: &hterror("Server Error", <<"EOF");
129: While handling a request for resource $address, the server crashed. Please
130: attempt to notify the administrators.
131: <p>Useful(?) debugging information:
132: <pre>
133: @_
134: </pre>
135: EOF
136: &log; exit;
137: }
138:
139: $SIG{'__DIE__'} = \&dead;
140: $SIG{'ALRM'} = \&bye;
141:
142: sub master {
143: $0 = "dhttpi: handling request";
144: # $sock = getpeername(STDIN);
145: $rfcdate = scalar gmtime;
146: ($dow, $mon, $dt, $tm, $yr) = ($rfcdate =~
147: m/(...) (...) (..) (..:..:..) (....)/);
148: $dt += 0; $yr += 0;
149: $rfcdate = "$dow, $dt $mon $yr $tm GMT";
150: $date = scalar localtime;
151: ($dow, $mon, $dt, $tm, $yr) = ($date =~
152: m/(...) (...) (..) (..:..:..) (....)/);
153: $dt += 0;
154: $dt = substr("0$dt", length("0$dt") - 2, 2);
155: $date = "$dt/$mon/$yr:$tm +0900";
156:
157: select(STDOUT); $|=1; $address = 0;
158: alarm 10;
159: while (<STDIN>) {
160: if(/^([A-Z]+)\s+([^\s]+)\s+([^\s\r\l\n]*)/) {
161: $method = $1;
162: $address = $2;
163: $httpver = $3;
164: $httpref = '';
165: $httpua = '';
166: $httpver = ($httpver =~ m#HTTP/([0-9]\.[0-9]+)#) ?
167: ($1) : (0.9);
168: $address =~ s#^http://[^/]+/#/#;
169: next unless ($httpver < 1);
170: } else {
171: s/[\r\l\n\s]+$//;
172: (/^Host: (.+)/i) && ($httphost = $1) && ($httphost =~
173: s/:\d+$//);
174: (/^Referer: (.+)/i) && ($httpref = $1);
175: (/^User-agent: (.+)/i) && ($httpua = $1);
176: (/^Content-length: (\d+)/i) && ($ENV{'CONTENT_LENGTH'} =
177: $httpcl = $1);
178: (/^Content-type: (.+)/i) && ($ENV{'CONTENT_TYPE'} =
179: $httpct = $1);
180: (/^Expect: /) && ($expect = 1);
181: (/^Authorization: Basic (.+)/i) && ($httprawu = $1);
182: (/^Range: (.+)/i) && ($ENV{'CONTENT_RANGE'} = $1);
183: next unless (/^$/);
184: }
185: if ($expect) {
186: &htsponse(417, "Expectation Failed");
187: &hterror("Expectation Failed",
188: "The server does not support this method.");
189: &log; exit;
190: }
191: if (!$address || (0+$httpver > 1 && !$httphost)) {
192: &htsponse(400, "Bad Request");
193: &hterror("Bad Request",
194: "The server cannot understand your request.");
195: &log; exit;
196: }
197: if ($method !~ /^(GET|HEAD|POST)$/) {
198: &htsponse(501, "Illegal Method");
199: &hterror("Illegal Method",
200: "Only GET, HEAD and POST are supported.");
201: &log; exit;
202: }
203: ($address, $variables) = split(/\?/, $address);
204: $address=~ s#^/?#/#;
205: 1 while $address =~ s#/\.(/|$)#\1#;
206: 1 while $address =~ s#/[^/]*/\.\.(/|$)#\1#;
207: 1 while $address =~ s#^/\.\.(/|$)#\1#;
208: $fail = 0;
209: J: foreach(sort { length $a <=> length $b }
210: keys %restrictions) {
211: next if ($address !~ /^$_/);
212: ($allowip, $denyip, $allowua, $denyua, $auser) =
213: split(/#/, $restrictions{$_});
214: if ($allowip || $denyip) {
215: ($hostname, $port, $ip) = &sock_to_host();
216: ($allowip && $ip !~ /$allowip/) && ($fail = 1,
217: last J);
218: ($denyip && $ip =~ /$denyip/) && ($fail = 1,
219: last J);
220: }
221: ($allowua && $httpua !~ /$allowua/) &&
222: ($fail = 2, last J);
223: ($denyua && $httpua =~ /$denyua/) &&
224: ($fail = 2, last J);
225: }
226: if ($fail) {
227: &htsponse(403, "Forbidden");
228: if ($fail == 1) {
229: &hterror("Forbidden (Client Disallowed)", <<"EOF");
230: Your network address (<i>$ip</i>) is not allowed to access this resource.
231: EOF
232: &log; exit;
233: } else {
234: &hterror("Forbidden (Browser Disallowed)", <<"EOF");
235: The browser you are using (<i>$httpua</i>) is not capable of or
236: is not allowed access to this resource.
237: EOF
238: &log; exit;
239: }
240: }
241: if ($auser) {
242: $httprawu =~ tr#A-Za-z0-9+/##cd;
243: $httprawu =~ tr#A-Za-z0-9+/# -_#;
244: $httprawu = unpack("u", pack("c", 32+0.75*length($httprawu))
245: . $httprawu);
246: ($httpuser, $httppw) = split(/:/, $httprawu);
247: $fail = 1;
248: foreach $user (split(/,/, $auser)) {
249: ($user, $pw) = split(/:/, $user);
250: ($fail = 0, last) if ($user eq $httpuser &&
251: crypt($httppw, substr($pw, 0, 2)) eq $pw);
252: }
253: if ($fail) {
254: $httpuser = '';
255: &htsponse(401, "Authorization Required");
256: &hthead("WWW-Authenticate: Basic realm=\"$address\"");
257: &hterror("Authorization Required", <<"EOF");
258: You must provide a username and password to use this resource. Either you
259: entered this information incorrectly, or your browser does not know how to
260: present the credentials required.
261: EOF
262: &log; exit;
263: }
264: }
265:
266:
267: $address =~ s/%([0-9a-fA-F]{2})/pack("H2", $1)/eg;
268: $raddress = "$path$address"
269: ;
270: &hterror301("http://ns.softbrain.co.kr:8088$address/")
271: if ($address !~ m#/$# && -d $raddress);
272: $raddress = "${raddress}index.html" if (-d $raddress);
273: alarm 0;
274: if(!sysopen(S, $raddress, 0)) { &hterror404; } else {
275: if (-x $raddress) {
276: $currentcode = 100;
277: &log;
278: if (!$<) {
279: ($x,$x,$x,$x,$uid,$gid) = stat(S);
280: (!$uid || !$gid) &&
281: die "executable is root-owned";
282: $> = $uid || die "can't set effuid";
283: $) = $gid || die "can't set effgid";
284: }
285: ($hostname, $port, $ip) = &sock_to_host() if (!$port);
286: $ENV{'REQUEST_METHOD'} = $method;
287: $ENV{'SERVER_NAME'} = "ns.softbrain.co.kr";
288: $ENV{'SERVER_PROTOCOL'} = "HTTP/$httpver";
289: $ENV{'SERVER_SOFTWARE'} = "HTTPi/$VERSION";
290: $ENV{'SERVER_PORT'} = "8088";
291: $ENV{'SERVER_URL'} = "http://ns.softbrain.co.kr:8088/";
292: $ENV{'SCRIPT_FILENAME'} = $raddress;
293: $ENV{'SCRIPT_NAME'} = $address;
294: $ENV{'REMOTE_HOST'} = $hostname;
295: $ENV{'REMOTE_ADDR'} = $ip;
296: $ENV{'REMOTE_PORT'} = $port;
297: $ENV{'QUERY_STRING'} = $variables;
298: $ENV{'HTTP_USER_AGENT'} = $httpua;
299: $ENV{'HTTP_REFERER'} = $httpref;
300: if ($pid = fork()) { exit; } else {
301: if ($method eq 'POST') { # needs stdin
302: open(W, "|$raddress") || die
303: "can't POST to $raddress";
304: read(STDIN, $buf, $httpcl);
305: print W $buf;
306: exit;
307: }
308: exec "$raddress", "$variables";
309: die "exec() returned -1";
310: }
311: }
312: ($x,$x,$x,$x,$x,$x,$x,$length,$x,$mtime) = stat(S);
313: $ctype = 0;
314: foreach(keys %content_types) {
315: if ($raddress =~ /\.$_$/i) {
316: $ctype = $content_types{$_};
317: }
318: }
319: SERVEIT: $ctype ||= 'text/plain';
320: &htsponse(200, "OK");
321: $mtime = scalar gmtime $mtime;
322: ($dow, $mon, $dt, $tm, $yr) =
323: ($mtime =~ m/(...) (...) (..) (..:..:..) (....)/);
324: $dt += 0; $yr += 0;
325: &hthead("Last-Modified: $dow, $dt $mon $yr $tm GMT");
326: if ($pid = fork()) { exit; }
327: alarm 25;
328: &htcontent("", $ctype, $length);
329: unless ($method eq 'HEAD') {
330: while(!eof(S)) {
331: read(S, $q, 16384);
332: print stdout $q;
333: }
334: }
335: alarm 0;
336: }
337: &log;
338: exit;
339: }
340:
341: exit;
342: }
343:
344:
345: sub hterror {
346: local($errstr, $expl) = (@_);
347: &htcontent(<<"EOF", "text/html");
348: <html>
349: <body>
350: <h1>$errstr</h1>
351: $expl
352: <hr>
353: <address><a href = "http://httpi.floodgap.com/">httpi/$VERSION</a>
354: by Cameron Kaiser</address>
355: </body>
356: </html>
357: EOF
358: }
359:
360: sub hterror404 {
361: &htsponse(404, "File Not Found");
362: &hterror("File Not Found",
363: "The resource $address was not found on this system.");
364: }
365:
366: sub hterror301 {
367: &htsponse(301, "Moved Permanently");
368: &hthead("Location: @_");
369: &hterror("Resource Moved Permanently",
370: "This resource has moved <a href = \"@_\">here</a>.");
371: $keep = 0; &log; exit;
372: }
373:
374: for (;;) {
375: $addr=accept(NS,S);
376: $statiosltr = scalar localtime;
377: $statiosreq++;
378: if ($pid = fork()) {
379: $0 = "dhttpi: waiting for child process";
380: waitpid($pid, 0);
381: $0 = "dhttpi: on ANY:8088, last request " .
382: scalar localtime;
383: } else {
384: $0 = "dhttpi: child switching to socket";
385: open(STDIN, "<&NS");
386: open(STDOUT, ">&NS");
387: &master;
388: exit;
389: }
390: }
|
