Content Accepted

#!/usr/bin/perl

# Very simple MOVE handler. Read the Apache Week article before attempting
# to use this script. You are responsible for ensure that this script is
# used securely.

# Original 'put1' script: <URL:http://www.apacheweek.com/features/put>
# Modified by T.Kusano <URL:http://www.asahi-net.or.jp/~AE5T-KSN/>
 
use strict;
use vars qw($filename $newuri $movelog $docroot);

# A simple log file, must be writable by the user that this program runs as.
# Should not be within the document tree.
$movelog = "/usr/local/apache/var/log/move.log";
$docroot = "/usr/local/apache/share/htdocs";

# Check we are using MOVE method
if ($ENV{'REQUEST_METHOD'} ne "MOVE") {
 &reply(500, "Request method is not MOVE");
}

# Note: should also check we are an authentication user by checking
# REMOTE_USER

# Check we got a destination filename
$filename = $ENV{'PATH_TRANSLATED'};
if (!$filename) { &reply(500, "No PATH_TRANSLATED"); }

$newuri = $ENV{'HTTP_NEW_URI'};
if (!$newuri) { &reply(500, "New-URI is not specified in request header"); }

# You must modify the following line!!
if ($newuri =~ m,^~,) {
  # rewrite this code by getpwnam() or something else ...
  $newuri =~ s,^\/~foobar,/home/foobar/public_html,;
} elsif ($newuri =~ m,^/,) {
  # put some rules for 'Alias' and so on
  $newuri = $docroot . $newuri;
} else {
  &reply(500, "Invalid New-URI");
}

rename($filename, $newuri) or &reply(500, "rename($filename,$newuri) fail[$!]");

# Everything seemed to work, reply with 204 (or 200). Should reply with 201
# if content was created, not updated.
&reply(200);

exit(0);

#
# Send back reply to client for a given status.
#

sub reply
{
    my($status, $message) = @_;
    my($remuser, $remhost, $logline) = ();

    print "Status: $status\n";
    print "Content-Type: text/html\n\n";

    if ($status == 200) {
        print "<HEAD><TITLE>OK</TITLE></HEAD><H1>Content Accepted</H1>\n";
    } elsif ($status == 500) {
        print "<HEAD><TITLE>Error</TITLE></HEAD><H1>Error Publishing File</H1>\n";
	print "An error occurred publishing this file ($message).\n";
    }
    # Note: status 204 and 201 gives have content part

    # Create a simple log
    $remuser = $ENV{'REMOTE_USER'} || "-";
    $remhost = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} || "-";
    
    $logline = "$remhost $remuser $filename status $status";
    $logline .= " ($message)" if ($status == 500);
    &log($logline);
    exit(0);
}

sub log
{
    my($msg) = @_;
    open (LOG, ">> $movelog") || return;
    print LOG "$msg\n";
    close(LOG);
}