File: http_webdav.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 (165 lines) | stat: -rw-r--r-- 8,006 bytes parent folder | download | duplicates (2)
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
package bedmod::http_webdav;
use Socket;

# This package is an extension to doona, to check
# for http server vulnerabilities.  Works as an extension to BED too
#
# Tests for WebDAV-specific request methods and request fields
# These aren't tested in the standard HTTP module.
#
# Modify as needed: might want to ensure the BCOPY requests a resource that exists
#
# The displayed output may not show particularly long commands (e.g. BPROPFIND /webpage.aspx) but 
# the right stuff is being sent
#
# Written by Grid

sub new {
    my $this = {};
    bless $this;
    return $this;
}

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

    $this->{proto}="tcp";

    if ($special_cfg{'p'} eq "") {
        $this->{port}='80';
    } else {
        $this->{port} = $special_cfg{'p'};
    }

    if ($special_cfg{'d'}) { return; }
    $iaddr = inet_aton($this->{target})             || die "Unknown host: $host\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, "HEAD / HTTP/1.0\r\n\r\n", 0)      || die "HTTP request failed: $!\n";
}


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";
    send(SOCKET, "HEAD / HTTP/1.0\r\n\r\n", 0)      || die "HTTP request failed: $!\n";
    my $resp = <SOCKET>;
    if (!$this->{healthy}) {
          if ($resp =~ /HTTP/) {
              $this->{healthy}=$resp;
          }
          # print "Set healthy: $resp";
    }
    return $resp =~ m/^$this->{healthy}$/;
}

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

sub getLoginarray {
    my $this = shift;
    @Loginarray = (
        "BCOPY /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",   
        "BDELETE /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",                 
        "BMOVE /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",          
        "BPROPFIND /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",      
        "BPROPPATCH /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",     
        "COPY /XAXAX.XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",           
        "DELETE /XAXAX.XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",           
        "LOCK /XAXAX.XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",           
        "MKCOL /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",          
        "MOVE /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",            
        "NOTIFY http://XAXAX:80 HTTP/1.1\r\nHost: myserver.com\r\n\r\n",           
        "POLL /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",
        "PROPFIND /XAXAX.XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",       
        "PROPPATCH /XAXAX.XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",      
        "SEARCH /XAXAX/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n",      
        "SUBSCRIBE /XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",      
        "UNLOCK /XAXAX.XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",         
        "UNSUBSCRIBE /XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",      
        "X-MS-ENUMATTS /XAXAX.XAXAX HTTP/1.1\r\nHost: myserver.com\r\n\r\n",      
      );
    return (@Loginarray);
}

sub getCommandarray {
    my $this = shift;

    @cmdArray = (                               # These are commands specific to webdav.
        "Destination: XAXAX\r\nHost: myserver.com\r\n",           
        "Depth: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Brief: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Overwrite: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Timeout: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Location: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Subscription-id: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Translate: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Call-Back: XAXAX\r\nHost: myserver.com\r\n\r\n",
        "Lock-Token: XAXAX\r\nHost: myserver.com\r\n\r\n",
      );
    return(@cmdArray);
}

sub getLogin {
    my $this = shift;
    @login = (
        "BCOPY /webpage.aspx/ HTTP/1.1\r\n",   
        "BDELETE /webpage.aspx/ HTTP/1.1\r\n",                 
        "BMOVE /webpage.aspx/ HTTP/1.1\r\n",          
        "BPROPFIND /webpage.aspx/ HTTP/1.1\r\n",      
        "BPROPPATCH /webpage.aspx/ HTTP/1.1\r\n",     
        "COPY /webpage.aspx HTTP/1.1\r\n",           
        "DELETE /webpage.aspx HTTP/1.1\r\n",           
        "LOCK /webpage.aspx HTTP/1.1\r\n",           
        "MKCOL /webpage.aspx HTTP/1.1\r\n",          
        "MOVE /webpage.aspx HTTP/1.1\r\n",            
        "NOTIFY http://myserver.com:80 HTTP/1.1\r\n",           
        "POLL /webpage.aspx/ HTTP/1.1\r\n",
        "PROPFIND /webpage.aspx HTTP/1.1\r\n",       
        "PROPPATCH /webpage.aspx HTTP/1.1\r\n",      
        "SEARCH /webpage.aspx/ HTTP/1.1\r\n",      
        "SUBSCRIBE /webpage.aspx HTTP/1.1\r\n",      
        "UNLOCK /webpage.aspx HTTP/1.1\r\n",         
        "UNSUBSCRIBE /webpage.aspx HTTP/1.1\r\n",      
        "X-MS-ENUMATTS /webpage.aspx HTTP/1.1\r\n",      
      );
    return(@login);
}

sub testMisc {         #Put your corner case tests here
    my $this = shift;
    @cmdArray = (
        "BCOPY /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "BDELETE /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "BMOVE /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "BPROPFIND /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "COPY /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "DELETE /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "LOCK /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "MKCOL /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "MOVE /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "NOTIFY /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "POLL /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "PROPFIND /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "PROPPATCH /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "SEARCH /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "SUBSCRIBE /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "UNLOCK /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "UNSUBSCRIBE /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
        "X-MS-ENUMATTS /webpage.aspx/ HTTP/1.1\r\nHost: myserver.com\r\n\r\n" . "Lotsofheaders: XAXAX\r\n" x 1024 . "\r\n",        
      );
    return(@cmdArray);
}

sub usage {
}

1;