Manage zFTPServer Suite using PERL

#!"c:/perl/bin/perl.exe"

use Strict;
use Net::Telnet;
use CGI;
   $CGI::POST_MAX=1024 * 5;  # max 5K posts
       $CGI::DISABLE_UPLOADS = 1;  # no uploads
use File::Path::Stderr;

my $query = new CGI;
my $t = new Net::Telnet ();



   my $port = 3145;
   my $admin_uname = "Admin";
   my ($admin_passwd, $uname, $passwd, $real_name, $new_domain, $vhpath);

   $admin_passwd = $query->param('Admin_pass');
   $uname = $query->param('new_user');
   $passwd = $query->param('new_password');
   $real_name = $query->param('real_name');
   $domain_name = $query->param('domain');
   $vhpath = "c\:\\sites\\vh\\$domain_name\.vh";

   mkpath("c\:\\sites\\$domain_name\\logs");
   mkpath("c\:\\sites\\$domain_name\\httpdocs");
   mkpath("c\:\\sites\\$domain_name\\cgi-bin");

   my @lines;
   $lines[0] = '<VirtualHost *:80>';
   $lines[1] = '   ServerAdmin admin@dj69.com';
   $lines[2] = '   DocumentRoot C:/sites/'.$domain_name.'/httpdocs/';
   $lines[3] = '   ServerName '.$domain_name;
   $lines[4] = '   ServerAlias www.'.$domain_name;
   $lines[5] = '   ErrorLog C:/sites/'.$domain_name.'/logs/error_log';
   $lines[6] = '   CustomLog C:/sites/'.$domain_name.'/logs/access_log common';
   $lines[7] = '   ScriptAlias /cgi-bin/ C:/sites/'.$domain_name.'/cgi-bin/';
   $lines[8] = '<Directory "C:/sites/'.$domain_name.'/httpdocs/">';
   $lines[9] = '   Options Includes';
   $lines[10] = '   AllowOverride None';
   $lines[11] = '   Order allow,deny';
   $lines[12] = '   Allow from all';
   $lines[13] = '</Directory>';
   $lines[14] = '</VirtualHost>';

   open FH, ">$vhpath";
   my $listitem;
   foreach $listitem ( @lines )
   {
      print FH $listitem, "\n";
   }


   close(FH);

print "Content-type:text/html\n\n";

   $t->open(port => $port);
print "port open\n";

# Next line is not needed from some reason.....
#   $t->waitfor('/200\s\./');
   print 'Got 220 (Got in)<br>';

# sending admin's user name
   $t->print('user ', $admin_uname);
   print "gave username<br>";

# checking for the correct response (331).
   $t->waitfor('/331 .*/') or die "dowant pass\n";
   print "Got 331 User name received, need password.<br>";

# sending admin's password
   $t->print('pass ', $admin_passwd);
   print "gave password.<br>";

#checking for the correct response (230).
   $t->waitfor('/230 .*/') or die "pass is not correct\n";
   print "got 230 User logged in, proceed.<br>";

#Adding the new user
   print "Adding new user $uname";
   $t->print('ADDUSER "', $uname, '" "', $passwd, '" "', $real_name, '"');
   $t->waitfor('/200 .*/') or die "user has not been creates\n";
   print "Got 200 User created successfully.<br>";

#connecting resources to the user.
   print "connecting resources";
   $t->print('SETRESOURCE "', $uname, '" "cgi-bin" "c\:\\sites\\', $domain_name, '\cgi-bin" "RF,WF,DF,AF,LD,MD,DD,RR"');
   $t->waitfor('/200 .*/') or die "user did not update\n";
print "Got 200 User(s) updated successfully.<br>";
   $t->print('SETRESOURCE "', $uname, '" "httpdocs" "c\:\\sites\\', $domain_name, '\httpdocs" "RF,WF,DF,AF,LD,MD,DD,RR"');
   $t->waitfor('/200 .*/') or die "user did not update\n";
print "Got 200 User(s) updated successfully.<br>";
   $t->print('SETRESOURCE "', $uname, '" "logs" "c\:\\sites\\', $domain_name, '\logs" "RF,LD,RR"');
   $t->waitfor('/200 .*/') or die "user did not update\n";
print "Got 200 User(s) updated successfully.<br>";



#   print "deleting user\n";
#   $t->print('DELUSER "', $uname, '"');
#   $t->waitfor('/200 .*/') or die "user has not been deleted\n";
#print "User(s) removed successfully.\n";

print "Quitting\n";
   $t->print('quit');
   $t-close;