#!/usr/bin/perl
# Pošle na výstup obsah souboru. Slouží jako obálka na statické soubory ve složkách CGI.
# (c) 2006 Dan Zeman <zeman@ufal.mff.cuni.cz>
# Licence: GNU GPL

use utf8; # říct Perlu, že konstantní řetězce ve zdrojáku jsou v UTF
use dancgi; # čtení parametrů z webu nebo z ARGV
do("cesta.pl"); # Načíst vnější i vnitřní cesty k dokumentům, jak platí na tomto počítači.
# Cesty jsou načteny do hashe %konfig, kam budeme chtít dát i jiné věci, ale nebudeme
# chtít, aby se cesty objevily v nových odkazech jako parametry skriptu. Proto
# musíme přejmenovat jejich klíče. (Zatím si netroufám upravit přímo cesta.pl,
# protože ho používá i řada jiných skriptů a musel bych je všechny projít a opravit.)
$cesta = $konfig{ccesta_html_www};
undef(%konfig);
$konfig{_cesta} = $cesta;



# Načíst parametry z URL.
dancgi::cist_parametry(\%konfig);
# Umožnit volat skript z příkazového řádku a předat parametry tam (např. perl prihlaseni.pl akce=caroly).
dancgi::rozebrat_parametry($ARGV[0], \%konfig);
# Není-li soubor předán jako parametr $konfig{soubor}, může být předán jako podcesta.
unless(exists($konfig{soubor}))
{
    $konfig{soubor} = $ENV{PATH_INFO};
}



# Vypsat záhlaví MIME.
if($konfig{soubor} =~ m/\.jpg$/i)
{
    $mime = "image/jpeg";
}
elsif($konfig{soubor} =~ m/\.png$/i)
{
    $mime = "image/png";
}
elsif($konfig{soubor} =~ m/\.gif$/i)
{
    $mime = "image/gif";
}
elsif($konfig{soubor} =~ m/\.mid$/i)
{
    $mime = "audio/rtp-midi";
}
else
{
    # Nemůžeme si dovolit otevřít cokoliv, o co si uživatel řekne.
    # Kdyby např. jméno souboru končilo svislítkem, mohl by uživatel pouštět příkazy na našem systému (to se už bohužel stalo).
    die;
}
print("Content-type: $mime\n\n");
open(SOUBOR, $konfig{soubor});
binmode(SOUBOR, ":raw");
binmode(STDOUT, ":raw");
while(<SOUBOR>)
{
    print;
}
close(SOUBOR);