#!/usr/bin/perl -wT
# Frederik Vermeulen 19981111

############################################################################
# put script for Apache
# implements roaming access support for Netscape4.5
# Frederik Vermeulen <Frederik.Vermeulen@esat.kuleuven.ac.be>
#  
# Distributed under GPL
#############################################################################

# Remarks: there is no delete script. You don't need one.
#          superseded by mod_roaming http://klomp.org/mod_roaming/

### Apache srm.conf
#<Directory /var/apache/html/zwerver>
#  Script PUT /cgi-bin/zwerver/put
#  AuthType Basic
#  AuthName "Roaming Access"
#  AuthUserFile /etc/apache/htpasswd-roam
#  require valid-user
#  AllowOverride AuthConfig
#</Directory>
#
#<Directory /var/apache/cgi-bin/zwerver>
#  AuthType Basic
#  AuthName "Roaming Access"
#  AuthUserFile /etc/apache/htpasswd-roam
#  require valid-user
#</Directory>

### Netscape preferences (prefs.js or preferences.js)
#user_pref("li.enabled", true);
#user_pref("li.login.name", "mylogin");
#user_pref("li.protocol", "http");
#user_pref("li.server.http.baseURL", "http://server.dom.ain/zwerver/$USERID");
#user_pref("li.server.http.useSimplePut", true);

### Config
my $datadir = '/var/apache/html/zwerver/';
my $maxfilesize = 64 * 1024;
my $maxdirsize = 128 * 1024; # when overwriting maxdirsize must
			     # provide room for old version
			     # + new version

use strict;

### Security checks
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';

if ($ENV{'REQUEST_METHOD'} ne 'PUT'){
    my $badrequestmethod = $ENV{'REQUEST_METHOD'};
    &reply(400, "Request method $badrequestmethod, PUT expected");
}

my $user;
if ($ENV{'REMOTE_USER'} =~ /^([a-z1-9]{2,8})$/){
    # Untaint
    $user = $1; 
} else {
    my $baduser = $ENV{'REMOTE_USER'} || 'unspecified, that is';
    &reply(403, "User $baduser not allowed");
}


my $file;
if ($ENV{'PATH_TRANSLATED'} =~ /^([a-zA-Z0-9_.\-\/]+)$/){
    # Untaint
    $file = $1;
    if ($file =~ /\.\./){
        # Don't give out PATH_TRANSLATED here!
        my $badfile = $ENV{'REQUEST_URI'};
        &reply(403, "Access to $badfile forbidden");
     }
} else {
    # Don't give out PATH_TRANSLATED here!
    my $badfile = $ENV{'REQUEST_URI'};
    &reply(403, "Access to $badfile forbidden");
}

my $userdir;
if ($file =~ m#^(.+)/([^/]+)$#){
    $userdir = $1;
}

if ($userdir ne $datadir . $user){
    # Don't give out PATH_TRANSLATED here!
    my $badfile = $ENV{'REQUEST_URI'};
    &reply(403, "Access to $badfile forbidden for $user");
}

if (!defined $ENV{'CONTENT_LENGTH'}){
    &reply(411, "Client failed to specify Content-Length");
}
my $length = $ENV{'CONTENT_LENGTH'};


if (-d $userdir){
    my $dirsize = 0;
    opendir (DIR, $userdir) ||
 	&reply(500, "Can't open user directory:$!\n");
    my @userfiles = readdir(DIR);
    closedir (DIR);
    for (@userfiles){
	next if -d "$userdir/$_";
        $dirsize += -s _;
    }

    if ($dirsize > $maxdirsize){
    	&reply(413, "User directory too large ($dirsize), contact admin");
    }elsif ($dirsize + $length > $ maxdirsize){
    	&reply(413, "File too large ($length) for your user quota");
    }elsif ($length > $maxfilesize){
        &reply(413, "File length $length too large");
    }
}

### Ready for the action

if (! -d $userdir){
    mkdir($userdir, 0700) ||
        reply(500, "Couldn't create directory $userdir: $!");
    my $htaccess = "$userdir/.htaccess";
    open (HTACCESS, ">$htaccess") ||
        reply(500, "Couldn't create $htaccess: $!");
    chmod 0600, $htaccess || 
        reply(500, "Couldn't make $htaccess exclusively user accessible: $!");
    print HTACCESS "require user $user\n";
    close HTACCESS;
}

my $newfile = 1;
if (-e $file){
    $newfile = 0;
}

open (FILE, ">$file") ||
        reply(500, "Couldn't create directory $userdir: $!");
chmod 0600, $file || 
        reply(500, "Couldn't make $userdir exclusively user accessible: $!");
while($length){
    my $data;
    my $bytes = read(STDIN, $data, 8192 < $length ? 8192 : $length);
    if (!defined($bytes)){
        reply(500, "Error reading input: $!");
    }
    $length -= $bytes;
    print FILE $data;
}
close FILE;

my $location = 'http://' . $ENV{'SERVER_NAME'} . $ENV{'REQUEST_URI'};
if ($newfile){
    &reply(201, "File created at $location", "Location: $location");
}else{
    &reply(204, '', "Location: $location");
}

### Never reached
exit 0;



sub reply{
    my($code, $message, $location) = @_;
    my %status = (200 => 'OK',
                  201 => 'Created',
                  204 => 'No content returned',
                  400 => 'Bad request',
                  403 => 'Forbidden',
		  411 => 'Length required',
		  413 => 'Request entity too large',
                  500 => 'Server error');
    my $status = $status{$code};

    print <<EOF;
Status: $code $status
Content-type: text/html
EOF

    if (defined $location){
        print "$location\n";
    }
    print "\n";
    if ($message){
        print <<EOF;
<HTML><HEAD>
<TITLE>$code $status</TITLE>
</HEAD><BODY>
<H1>$status</H1>
$message.<P>
</BODY></HTML>
EOF
    }

exit ($code < 300) ?  0 : 1;
}