This is a simple FTP srver, which supports the basic FTP needs. Program is multi-threaded, so it supports multiple clients at the same time. Tested with the command line ftp client came with Windows XP, and was fine.

use IO::Socket::INET;
use threads;

use strict;
use Data::Dumper;

$| ++;

my $s = IO::Socket::INET->new(Proto => "tcp", LocalPort => 21, Listen 
+=> 10, Reuse => 1);
while (my $cc = $s->accept()) {
    threads->create(\&session, $cc);
    #session($cc);
}

sub session {
     my $cc = shift;
    print $cc "220 Service ready\r\n";
    my $daddr;
    my $dport;
    my $type = 'A';
    while (my $res = <$cc>) {
        $res =~ /(.*)\r\n/;
        $res = $1;
        print "<$res>\n";    
        if ($res =~ /USER (.+)/) {
            print $cc "331 user name okay, need password\r\n";
        } elsif ($res =~ /PASS (.+)/) {
            print $cc "230 User logged in\r\n";
        } elsif ($res =~ /TYPE (\w)/) {
            $type = $1;
            print $cc "200 Command okay.\r\n";
        } elsif ($res =~ /PORT (\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
            $dport = ($5 << 8) + $6;
            $daddr = "$1.$2.$3.$4";
            print $cc "200 Command okay.\r\n";
        } elsif ($res =~ /STOR (.+)/) {
            my $filename = $1;
            open FILE, ">", $filename;
            print $cc "150 File status okay; about to open data connec
+tion.\r\n";
            my $dc = IO::Socket::INET->new(Proto => "tcp", PeerAddr =>
+ $daddr, PeerPort => $dport, Reuse => 1);
            if ($type eq 'I') {
                binmode($dc);
                binmode(FILE);
            } 
            my $data;
            while (read($dc, $data, 1024)) {
                syswrite(FILE, $data);
            }
            close(FILE);
            print $cc "226 Closing data connection, file transfer succ
+essful\r\n";
            close($dc);
        } elsif ($res =~ /RETR (.+)/) {
            my $filename = $1;
            if (open FILE, "<", $filename) {
                print $cc "150 File status okay; about to open data co
+nnection.\r\n";
                my $dc = IO::Socket::INET->new(Proto => "tcp", PeerAdd
+r => $daddr, PeerPort => $dport, Reuse => 1);
                if ($type eq 'I') {
                    binmode($dc);
                    binmode(FILE);
                }     
                my $data;
                while (read(FILE, $data, 1024)) {
                    send($dc, $data, 0);
                }
                close(FILE);
                print $cc "226 Closing data connection, file transfer 
+successful\r\n";
                close($dc);
            } else {
                print $cc "450 Requested file action not taken. File u
+navailable.\r\n";
            }
        } elsif ($res =~ /QUIT/) {
            close($cc);
                        last;
        } else {
        }
    }
}

[download]

In reply to A simple FTP server by pg

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.