package XXV::MODULES::HTTPD;

use Locale::gettext;
use XXV::OUTPUT::Html;
use XXV::OUTPUT::Ajax;
use IO::Socket::INET;
use MIME::Base64;
use CGI qw/:push -nph -no_xhtml -compile/;
use File::Basename;
use File::Find;

use Tools;

$| = 1;

use strict;

my $mime = {
    png  => "image/png",
    gif  => "image/gif",
    jpg  => "image/jpeg",
    css  => "text/css",
    ico  => "image/x-icon",
    js   => "application/x-javascript",
    m3u  => "audio/x-mpegurl",
    rss  => "application/xhtml+xml"
};

# This module method must exist for XXV
# ------------------
sub module {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $args = {
        Name => 'HTTPD',
        Description => gettext('This module is a multisession HTTPD server.'),
        Version => '0.45',
        Date => '04.09.2005',
        Author => 'xpix',
        Status => sub{ $obj->status(@_) },
        Preferences => {
            active => {
                description => gettext('Activate this service'),
                default     => 'y',
                type        => 'confirm',
                required    => gettext('This is required!'),
            },
            Clients => {
                description => gettext('Maximum number of allowed connections at a time'),
                default     => 5,
                type        => 'integer',
                required    => gettext('This is required!'),
            },
            Port => {
                description => gettext('Portnumber to connect the client'),
                default     => 8080,
                type        => 'integer',
                required    => gettext('This is required!'),
            },
            HtmlRoot => {
                description => gettext('tmpl files and images for http server (useful for skins)'),
                default     => 'html',
                type        => 'list',
                required    => gettext('This is required!'),
                choices     => sub{ return $obj->findskins },
            },
            StartPage => {
                description => gettext('First page to see at logon'),
                default     => 'now',
                type        => 'list',
                required    => gettext('This is required!'),
                choices     => [
                    [ gettext('Schema'),          'schema'],
                    [ gettext('Running now'),     'now'],
                    [ gettext('Program guide'),   'program'],
                    [ gettext('Autotimer'),       'alist'],
                    [ gettext('Timers'),          'tlist'],
                    [ gettext('Recordings'),      'rlist'],
                    [ gettext('Music'),           'mlist'],
                    [ gettext('Remote'),          'remote'],
                    [ gettext('Teletext'),        'vtxpage'],
                    [ gettext('Status'),          'sa'],
                ],
            },
        },
        Commands => {
            logout => {
                description => gettext("Logout from the current Session"),
                short       => 'logout',
                callback    => sub{
                    my $watcher = shift || return error ('No Watcher!');
                    my $console = shift || return error ('No Console');

                    my $userMod = main::getModule('USER');
                    if(ref $userMod and $userMod->{active} eq 'y') {
                        $console->message(gettext("Closed session."));
                        $console->redirect({url => '?', parent => 'top', wait => 2})
                            if($console->typ eq 'HTML');


                        # Close session delayed, give browser my time load depends files like style.css
                        Event->timer(
                            after => 1,
                            prio => 6,  # -1 very hard ... 6 very low
                            cb => sub{
                                my $userMod = main::getModule('USER');
                                $userMod->logout;
                                delete $console->{USER};
                                $obj->{LOGOUT} = 1;
                            },
                        );
                    }
                },
            },
        },
    };
    return $args;
}

# ------------------
sub new {
# ------------------
	my($class, %attr) = @_;
	my $self = {};
	bless($self, $class);

    # paths
    $self->{paths} = delete $attr{'-paths'};

	# who am I
    $self->{MOD} = $self->module;

    # all configvalues to $self without parents (important for ConfigModule)
    map {
        $self->{$_} = $attr{'-config'}->{$self->{MOD}->{Name}}->{$_} || $self->{MOD}->{Preferences}->{$_}->{default}
    } keys %{$self->{MOD}->{Preferences}};

    # read the DB Handle
    $self->{dbh} = delete $attr{'-dbh'};

    # The Initprocess
    $self->init or return error('Problem to initialze Module');

	return $self;
}

# ------------------
sub init {
# ------------------
    my $obj = shift || return error ('No Object!' );

    # globals
    my $channels;

    $obj->{STATUS}->{'starttime'} = scalar localtime;

    # make socket
	my $socket = IO::Socket::INET->new(
		Listen		=> $obj->{Clients} || 5,
		LocalPort	=> $obj->{Port}    || 8005,
		Reuse		=> 1);
	warn sprintf("[Fatal] Cannot build initial socket for %s on port %d. [%s]\n",
	        $obj->{Name}, $obj->{Port}, $!) unless $socket;

    # install an initial watcher
    Event->io(
        fd => $socket,
        cb => sub {
            # accept client
            my $client=$socket->accept;
            warn "[Error] Cannot connect http to new client.\n" and return unless $client;
            $client->autoflush;

            # make "channel" number
            my $channel=++$channels;

            $obj->{STATUS}->{'connects'}++;

            # install a communicator
            Event->io(
                fd => $client,
                poll => 'r',
                cb => sub {
                   my $watcher = shift;

                    # read new line and report it
                    my $handle=$watcher->w->fd;

                    my $data = $obj->parseRequest($handle,(exists $obj->{LOGOUT} && $obj->{LOGOUT} == 1 ));
                    unless($data) {
                        $watcher->w->cancel;
                        $handle->close();
                        undef $watcher;
                        return 1;
                    }
                    my $htmlRootDir = sprintf('%s/%s', $obj->{paths}->{HTMLDIR}, $obj->{HtmlRoot});
                    my $cgi = CGI->new( $data->{Query} );

                    undef $obj->{LOGOUT}
                        if(exists $obj->{LOGOUT});

                    my $console;
                    if(my $outputtype = $cgi->param('ajax')) {
                        # Is a Ajax Request
                        $console = XXV::OUTPUT::Ajax->new(
                            -handle => $handle,
                            -cgi    => $cgi,
                            -browser=> $data,
                            -output => $outputtype,
                        );
                    } else {
                        # Is a Html Request
                        $console = XXV::OUTPUT::Html->new(
                            -handle => $handle,
                            -dbh    => $obj->{dbh},
                            -htmdir => $htmlRootDir,
                            -cgi    => $cgi,
                            -mime   => $mime,
                            -browser=> $data,
                            -paths  => $obj->{paths},
                            -start  => $obj->{StartPage},
                        );
                    }

                    my $userMod = main::getModule('USER');
                    if(ref $userMod and $userMod->{active} eq 'y') {
                        $console->{USER} = $userMod->check($handle, $data->{username}, $data->{password});
                        $console->login(gettext('You have no permissions to this system!'))
                            unless(exists $console->{USER}->{Name});
                        $console->{call} = 'index';
                    }

                    if(ref $userMod and
                            ($userMod->{active} ne 'y'
                                or exists $console->{USER}->{Name})) {

                        $console->{call} = 'nothing';
                        if(($data->{Request} eq '/' or $data->{Request} =~ /\.html$/) and not $data->{Query}) {
                            # Send the first page (index.html)
                            my $page = $data->{Request};
                            if($page eq '/') {
                                if(-r sprintf('%s/index.tmpl', $htmlRootDir)) {
                                    $console->index;
                                } else {
                                    $console->datei(sprintf('%s/index.html', $htmlRootDir));
                                }
                            } else {
                                $console->datei(sprintf('%s/%s', $htmlRootDir, $page));
                            }
                        } elsif(my $typ = $mime->{lc((split('\.', $data->{Request}))[-1])}) {
                            # Send multimedia files (this must registered in $mime!)
                            if($data->{Request} =~ /epgimages\//) {
                                my $epgMod = main::getModule('EPG');
                                $data->{Request} =~ s/.*epgimages\//$epgMod->{epgimages}\//;
                                $console->image($data->{Request}, $typ);
                            } elsif($data->{Request} =~ /previewimages\//) {
                                my $recMod = main::getModule('RECORDS');
                                $data->{Request} =~ s/.*previewimages\//$recMod->{previewimages}\//;
                                $console->image($data->{Request}, $typ);
                            } elsif($data->{Request} =~ /coverimages\//) {
                                my $musicMod = main::getModule('MUSIC');
                                $data->{Request} =~ s/.*coverimages\//$musicMod->{coverimages}\//;
                                $console->image($data->{Request}, $typ);
                            } elsif($data->{Request} =~ /vtximages\//) {
                                my $vtxMod = main::getModule('VTX');
                                $data->{Request} =~ s/.*vtximages\//$obj->{paths}->{VTXPATH}\//;
                                $console->image($data->{Request}, $typ);
                            } elsif($data->{Request} =~ /tempimages\//) {
                                my $user = ($userMod->{active} eq 'y' ? $console->{USER}->{Name} : "nobody");
                                my $tmp = $userMod->userTmp($user);
                                $data->{Request} =~ s/.*tempimages\//$tmp\//;
                                $console->image($data->{Request}, $typ);
                            } else {
                                $console->image(sprintf('%s%s', $htmlRootDir, $data->{Request}), $typ);
                            }
                        } elsif( $cgi->param('binary') ) {
                            # Send multimedia files (if param binary)
                            $obj->handleInput($watcher, $console, $cgi);
                        } else {
                            $obj->handleInput($watcher, $console, $cgi);
                            $console->footer() if($console->typ ne 'AJAX');
                        }

                    }
                    $console->printout();
                    $watcher->w->cancel;
                    undef $watcher;
                    $handle->close();
                }, # End Sub
            );
        },
    ) if($obj->{active} eq 'y');

    return 1;

}

# ------------------
sub parseRequest {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $hdl = shift || return error ('No Handle!' );
    my $logout = shift || 0;

    my ($Req, $size) = getFromSocket($hdl);
    $obj->{STATUS}->{'readbytes'}+= $size;

	if($Req->[0] =~ /^GET (\/[\w\.\/-\:\%]*)([\?[\w=&\.\+\%-\:\!]*]*)[\#\d ]+HTTP\/1.\d$/) {
        my $data = {};
		($data->{Request}, $data->{Query}) = ($1, $2 ? substr($2, 1, length($2)) : undef);

    	# parse header
    	foreach my $line (@$Req) {
    		if($line =~ /Referer: (.*)/) {
    			$data->{Referer} = $1;
    		}
    		if($line =~ /Host: (.*)/) {
    			$data->{HOST} = $1;
    		}
    		if($line =~ /Authorization: basic (.*)/i and not $logout) {
    			($data->{username}, $data->{password}) = split(":", MIME::Base64::decode_base64($1), 2);
    		}
    		if($line =~ /User-Agent: (.*)/i) {
    			$data->{http_useragent} = $1;
    		}
    		if($line =~ /Accept-Encoding:.+?gzip/i) {
    			$data->{accept_gzip} = 1;
    		}
    	}
        $data->{Request} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

        lg sprintf(qq|
-----------------------------------------
New Request from User: %s at Host: %s!
Query: %s
-----------------------------------------
|, $data->{username}, $data->{HOST}, $data->{Query});

        return $data;
	} else {
        warn sprintf("Unknown Request: <%s>\n", join("\n", @$Req));
        return;
	}

}

# ------------------
sub handleInput {
# ------------------
    my $obj     = shift || return error ('No Object!' );
    my $watcher = shift || return error ('No Watcher!');
    my $console = shift || return error ('No Console');
    my $cgi     = shift || return error ('No CGI Object');

    my $ucmd    = $cgi->param('cmd')  || '<undef>';
    my $udata   = $cgi->param('data') || '';

    # Set the referer, if come a form with a error
    # then patch the referer
    $console->{browser}->{Referer} = $cgi->param('referer')
        if($cgi->param('referer'));

    # Test on result set (user has save) and
    # get the DataVars in a special Hash
    my $result;
    foreach my $name ($cgi->param) {
        if(my ($n) = $name =~ /^__(.+)/sig) {
            my @vals = $cgi->param($name);
            if(scalar @vals > 1) {
                @{$result->{$n}} = @vals;
            } else {
                $result->{$n} = shift @vals;
            }
        }
    }

    # Test the command on exists, permissions and so on
    my $u = main::getModule('USER');
    my ($cmdobj, $cmdname, $shorterr, $err) = $u->checkCommand($console, $ucmd);
    $console->{call} = $cmdname;
    if($cmdobj and not $shorterr) {
        $console->{CMDSTAT} = $cmdobj->{callback}($watcher, $console, $udata, $result );
    } elsif($shorterr eq 'noperm' or $shorterr eq 'noactive') {
        $console->err($err);
        $console->{CMDSTAT} = undef;
    } else {
        $obj->usage($watcher, $console, undef, $err);
        $console->{CMDSTAT} = undef;
    }
}

# ------------------
sub usage {
# ------------------
    my $obj = shift || return error ('No Object!' );
    return main::getModule('TELNET')->usage(@_);
}

# ------------------
sub status {
# ------------------
    my $obj = shift || return error ('No Object!' );
    my $watcher = shift;
    my $console = shift || return;
    my $lastReportTime = shift || 0;

    return {
        message => sprintf(gettext('Traffic on HTTPD Socket since %s: send: %d kbytes - received: %d kbytes - connects: %d'),
            $obj->{STATUS}->{'starttime'}, convert($console->{sendbytes}), convert($obj->{STATUS}->{'readbytes'}), $obj->{STATUS}->{'connects'} ),
    };

}

# ------------------
sub findskins
# ------------------
{
    my $obj = shift || return error ('No Object!' );
    my $found;
    find({ wanted => sub{
              if(-d $File::Find::name
                    and ( -e $File::Find::name.'/index.tmpl'
                      or  -e $File::Find::name.'/index.html')
              ) {
                    my $l = basename($File::Find::name);
                    push(@{$found},[$l,$l]);
                }
           },
           follow => 1,
           follow_skip => 2,
        },
        $obj->{paths}->{HTMLDIR}
    );
    warn "Can't find useful HTML Skin at : ", $obj->{paths}->{HTMLDIR}
        if(scalar $found == 0);
    return $found;
}


1;
