cranberry.pl

cranberry.pl

#!/usr/bin/env perl
package Cranberry;
use 5.010;
use strict;
use warnings;

use HTTP::Status qw/status_message/;
use HTTP::Request;
use HTTP::Response;
use IO::Socket;
use Template;

################################
our %server = (
    name    => 'Cranberry',
    version => '0.01',
);
################################
#여기부턴 서버의 코어 부분입니다.
################################

my $config;
my $sock;
my @children;

INIT {
    #서버의 초기화 부분.

    #SIGPIPE / SIGCHLD를 무시하도록 합니다.
    $SIG{'PIPE'} = 'IGNORE';
    $SIG{'CHLD'} = 'IGNORE';

    #출력 버퍼링을 비활성화 합니다.
    local $| = 1;

    $config = Cranberry::ConfigParser->parse_config();
    
    $sock = IO::Socket::INET->new (
        #TODO : YAML 설정 파일로부터 설정값을 읽어서 포트 설정.
        LocalPort => $config->{Server}->{Port},
        Proto     => 'tcp',
        Listen    => 1,
        Reuse     => 1,
    ) or die "서버를 시작할 수 없습니다! : $!\n";
    
    printf ("서버가 시작되었습니다! (%s)\n", $config->{Server}->{Port});
}

while (my $client = $sock->accept()) {
    my $pid = fork();
    die "프로세스 포크에 실패하였습니다." unless (defined $pid);
    
    #부모 프로세스의 경우 $pid에 자식의 PID값을 받습니다.
    if ($pid) {
        push @children, $pid;
        next;
    }
    
    #자식은 접속을 받는 소켓을 닫습니다.
    close $sock;
    
    $client->autoflush(1);
    my ($request, $raw_request);
    
    while (<$client>) {
        $raw_request .= $_;
        print $_;
        
        if ($_ eq "\r\n") {
            $request = HTTP::Request->parse($raw_request);       
            last;
        }
    }
    
    
    process_request($client, $request);
    
    close($client);
    exit(0);
}

sub process_request {
    my ($client, $request) = @_;
    
    unless ($request) {
        send_error($client, 400);
    } elsif ($request->method eq "GET") {
        send_file($client, $request);
    } elsif ($request->method eq "POST") {
        #TODO : recv_file ($client, $request);
    } elsif ($request->method eq "HEAD") {
        #TODO : send_file($client, $request, 0);
    } elsif ($request->method eq "OPTIONS") {
        options($client);
    } else {
        send_error($client, 501);
    }
}


sub send_file {
    my ($client, $request) = @_;
    send_error($client, 404);
}

sub send_error {
    my ($client, $status_code) = @_;

    print $client header($status_code, {
        'Content-Type' => 'text/html'
    });
    print $client status_message($status_code);
}

sub options {
    my $client = shift;
    print $client header(200, {
        'Allow' => 'GET,POST,HEAD,OPTIONS',
    });
    
}

sub header {
    my $status_code = shift;
    my %header      = %{($_[0])} if $_[0];
    
    $status_code = 500 unless $status_code;
    
    my $response = HTTP::Response->new($status_code);
    $response->header(
        'Server'     => $server{name}.'/'.$server{version},
        'Connection' => 'close',
        %header
    );
    
    return "HTTP/1.1 ".$response->as_string;
}
1;

package Cranberry::ConfigParser;
use strict;
use warnings;
use utf8;

use YAML::Tiny;

#설정 파일을 읽어내는 모듈입니다.

sub parse_config {
    my $filename = shift;
    $filename = "config.yaml" if $filename;
    
    unless (-e $filename) {
        warn sprintf("주의 : 설정 파일 %s이 없습니다.\n", $filename);
        return default_config();
    }
    my $yaml = YAML::Tiny->new;
    return $yaml->read($filename)->[0];
}

sub default_config {
    {
        Server => {
            Accept => 0.0.0.0,
            Port   => 8080,
        },
        Mount  => {
            './share',
        },
    }
}

1;