File: ftp.pm

package info (click to toggle)
doona 1.0%2Bgit20190108-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 276 kB
  • sloc: perl: 2,287; makefile: 4; sh: 1
file content (254 lines) | stat: -rw-r--r-- 8,787 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
package bedmod::ftp;
use Socket;

# This package is an extension to bed, to check
# for ftp server vulnerabilities.

sub new {
    my $this = {};
    $this->{'healthy'}    = undef;
    $this->{username}     = 'anonymous'; # specific for just this
    $this->{password}     = 'user@this.bed'; # module
    bless $this;
    return $this;
}

sub init {
    my $this = shift;
    %special_cfg=@_;

    # Specify protocol to use
    $this->{proto}="tcp";
    # check for missing args, set target and host
    if ($special_cfg{'p'} eq "") { $this->{port}='21'; }
    else { $this->{port} = $special_cfg{'p'}; }

    # get info nessecairy for FTP
    $this->{username} = $special_cfg{'u'} if $special_cfg{'u'};
    $this->{password} = $special_cfg{'v'} if $special_cfg{'v'};
    $this->{vrfy} = "PWD\r\n";

    # let's see if we got a correct login (skip if dump mode is set)
    if ($special_cfg{'d'}) { return; }
    die "FTP server failed health check!\n" unless($this->health_check());
    $iaddr = inet_aton($this->{target})             || die "Unknown host: $this->{target}\n";
    $paddr = sockaddr_in($this->{port}, $iaddr)     || die "getprotobyname: $!\n";
    $proto = getprotobyname('tcp')                  || die "getprotobyname: $!\n";
    socket(SOCKET, PF_INET, SOCK_STREAM, $proto)    || die "socket: $!\n";
    connect(SOCKET, $paddr)                         || die "connection attempt failed: $!\n";
    send(SOCKET, "USER $this->{username}\r\n", 0)   || die "USER failed: $!\n";
    $recvbuf = <SOCKET>;
    sleep(1);                                       # some ftp's need some time to reply
    send(SOCKET, "PASS $this->{password}\r\n", 0)   || die "PASS failed: $!\n";
    do {
        $recvbuf = <SOCKET>;
        #print ($recvbuf);
        if ( $recvbuf =~ "530" ){
            print ("Username or Password incorrect, can't login\n");
            exit(1);
        }
        sleep(0.2);
      } until ( $recvbuf =~ "230" );
    send(SOCKET, "QUIT\r\n", 0);
    close(SOCKET);
}

sub health_check {
    my $this = shift;
    $iaddr = inet_aton($this->{target})             || die "Unknown host: $this->{target}\n";
    $paddr = sockaddr_in($this->{port}, $iaddr)     || die "getprotobyname: $!\n";
    $proto = getprotobyname('tcp')                  || die "getprotobyname: $!\n";
    socket(SOCKET, PF_INET, SOCK_STREAM, $proto)    || die "socket: $!\n";
    connect(SOCKET, $paddr)                         || die "connection attempt failed: $!\n";
    do { 
      $recv=<SOCKET>;
      sleep(0.2);
    } until $recv =~ /^220/;
    send(SOCKET, "PASS\r\n", 0);
    $recv=<SOCKET>;
    if (!$this->{'healthy'}) {
        $this->{'healthy'} = $recv if ($recv =~ /^\d\d\d/);
    }
    return $recv =~ /^$this->{'healthy'}$/;
}

sub getQuit {
    return("QUIT\r\n");
}

sub getLoginarray {
    my $this = shift;
    @Loginarray = (
        "XAXAX\r\n",
        "USER XAXAX\r\n",
        "USER XAXAX\r\nPASS password\r\n",
        "USER anonymous\r\nPASS XAXAX\r\n",
        "USER XAXAX\r\nPASS password\r\nUSER $this->{username}\r\nPASS XAXAX\r\n",
        "USER $this->{username}\r\nPASS XAXAX\r\n",
        "PASS XAXAX\r\n"
      );
    return (@Loginarray);
}

sub getCommandarray {
    my $this = shift;

    # the XAXAX will be replaced with the buffer overflow / format string
    # just comment them out if you don't like them..
    @cmdArray = (
        "XAXAX\r\n",
        "XAXAX 123\r\n",
        "ABOR XAXAX\r\n",
        "ACCL XAXAX\r\n",
        "ACCT XAXAX\r\n",
        "ADAT XAXAX\r\n",
        "ALLO XAXAX\r\n",
        "APPE XAXAX\r\n",
        "APPE /XAXAX\r\n",
        "CCC XAXAX\r\n",
        "CDUP XAXAX\r\n",
        "CONF XAXAX\r\n",
        "CWD XAXAX\r\n",
        "CEL XAXAX\r\n",
        "DELE XAXAX\r\n",
        "ENC XAXA\r\n",
        "EPRT XAXAX\r\n",
        "EPRT |XAXAX|127.0.0.1|6275|\r\n",
        "EPRT |1|XAXAX|6275|\r\n",
        "EPRT |1|127.0.0.1|XAXAX|\r\n",
        "EPSV XAXAX\r\n",
        "FEAT XAXAX\r\n",
        "HELP XAXAX\r\n",
        "LANG XAXAX\r\n",
        "LIST XAXAX\r\n",
        "LIST -XAXAX\r\n",
        "LIST *XAXAX\r\n",
        "LOCK XAXAX\r\n",
        "LOCK / XAXAX\r\n",
        "LPRT XAXAX\r\n",
        "LPSV XAXAX\r\n",
        "MDTM XAXAX\r\n",
        "MDTM XAXAX file.txt\r\n",
        "MDTM 19990929043300 XAXAX\r\n",
        "MDTM 20031111111111+ XAXAX\r\n",
        "MIC XAXAX\r\n",
        "MLST XAXAX\r\n",
        "MODE XAXAX\r\n",
        "MKD XAXAX\r\n",
        "MKD XAXAX\r\nCWD XAXAX\r\n",
        "MKD XAXAX\r\nDELE XAXAX\r\n",
        "MKD XAXAX\r\nRMD XAXAX\r\n",
        "MKD XAXAX\r\nXRMD XAXAX\r\n",
        "NLST XAXAX\r\n",
        "NLST ~XAXAX\r\n",
        "NOOP XAXAX\r\n",
        "OPTS XAXAX\r\n",
        "PASS XAXAX\r\n",
        "PASV XAXAX\r\n",
        "PBSZ XAXAX\r\n",
        "PORT XAXAX\r\n",
        "PWD XAXAX\r\n",
        "QUOTE XAXAX\r\n",
        "REIN XAXAX\r\n",
        "REST XAXAX\r\n",
        "RETR XAXAX\r\n",
        "RMD XAXAX\r\n",
        "RNFR XAXAX\r\n",
        "RNTO XAXAX\r\n",
        "RNFR XAXAX\r\nRNTO XAXAX\r\n",
        "SITE XAXAX\r\n",
        "SITE EXEC XAXAX\r\n",
        "SITE GROUPS XAXAX\r\n",
        "SITE CDPATH XAXAX\r\n",
        "SITE ALIAS XAXAX\r\n",
        "SITE INDEX XAXAX\r\n",
        "SITE MINFO 20001010101010 XAXAX\r\n",
        "SITE NEWER 20001010101010 XAXAX\r\n",
        "SITE GPASS XAXAX\r\n",
        "SITE GROUP XAXAX\r\n",
        "SITE HELP XAXAX\r\n",
        "SITE IDLE XAXAX\r\n",
        "SITE CHMOD XAXAX\r\n",
        "SITE CHMOD 777 XAXAX\r\n",
        "SITE UMASK XAXAX\r\n",
        "SIZE XAXAX\r\n",
        "SIZE /XAXAX\r\n",
        "SMNT XAXAX\r\n",
        "STOU XAXAX\r\n",
        "STRU XAXAX\r\n",
        "STOR XAXAX\r\n",
        "STAT XAXAX\r\n",
        "SYST XAXAX\r\n",
        "TYPE XAXAX\r\n",
        "USER XAXAX\r\n",
        "UNLOCK XAXAX\r\n",
        "UNLOCK / XAXAX\r\n",
        "XCUP XAXAX\r\n",
        "XCWD XAXAX\r\n",
        "XMD5 XAXAX\r\n",
        "XMKD XAXAX\r\n",
        "XPWD XAXAX\r\n",
        "XRCP XAXAX\r\n",
        "XRMD XAXAX\r\n",
        "XRSQ XAXAX\r\n",
        "XSEM XAXAX\r\n",
        "XSEN XAXAX\r\n",
      );
    return(@cmdArray);
}

sub getLogin {       # login procedure
    my $this = shift;
    @login = ("USER $this->{username}\r\nPASS $this->{password}\r\n");
    return(@login);
}

sub testMisc {
    my $this = shift;
    return; # Directory traversal code is buggy an not really what I want
    # test for bof in login / user ?
    # test for the availability to abuse this host for portscanning ?

    # test for possible directory traversal bugs...
    print ("*Directory traversal\n");

    @traversal = ("...", "%5c..%5c", ,"%5c%2e%2e%5c", "/././..", "/...", "/......", "\\...", "...\\", "....", "*", "\\*", "\\....", "*\\\\.....", "/..../", "/../../../", "\\..\\..\\..\\", "\@/..\@/..");
    foreach $Directory (@traversal){
        $iaddr = inet_aton($this->{target})             || die "Unknown host: $this->{target}\n";
        $paddr = sockaddr_in($this->{port}, $iaddr)     || die "getprotobyname: $!\n";
        $proto = getprotobyname('tcp')                  || die "getprotobyname: $!\n";
        socket(SOCKET, PF_INET, SOCK_STREAM, $proto)    || die "socket: $!\n";
        connect(SOCKET, $paddr)                         || die "connection attempt failed: $!\n";
        send(SOCKET, "USER $this->{username}\r\n", 0)   || die "USER failed: $!\n";
        sleep(2); # some ftp's need some time to reply
        $recvbuf = <SOCKET>;
        send(SOCKET, "PASS $this->{password}\r\n", 0)   || die "PASS failed: $!\n";
        sleep(2); # some ftp's need some time to reply
        $recvbuf = <SOCKET>                             || die "Login failed $!\n";
        send(SOCKET, "PWD\r\n", 0);                 # get old directory
        sleep(1);
        $curDir = <SOCKET>;
        send(SOCKET, "CWD $Directory\r\n", 0);      # send the traversal string
        # clear the buffer, by waiting for :
        # 501 550 250 553
        do { $recvbuf = <SOCKET>; } while( ($recvbuf !~ /550/) && ($recvbuf !~ /250/) && ($recvbuf !~ /553/) && ($recvbuf !~ /501/)); # receive answer
        send(SOCKET, "PWD\r\n", 0);                 # get new directory
        $newDir = <SOCKET>;

        # compare the directories, and report a problem if they are not equal
        if ( $curDir ne $newDir ){ print ("Directory Traversal ($curDir => $newDir) possible with $Directory \n"); }
        send(SOCKET,"QUIT\r\n", 0);  # logout
        close (SOCKET);              # close connection
    }
    return();
}

sub usage {
    print qq~ FTP Module specific options:
 -u <username> = Username to use for authentication (default: anonymous)
 -v <password> = Password to use for authentication (default: user\@this.bed)

~;
}

1;