5 # This file is part of LyX, the document processor.
6 # Licence details can be found in the file COPYING.
8 # authors: Kornel Benko <kornel@lyx.org>
9 # Scott Kostyshak <skotysh@lyx.org>
12 # Check if given URL exists and is accessible
20 @EXPORT = qw(check_url);
24 sub check_http_url($$$$);
25 sub check_ftp_dir_entry($$);
26 sub check_ftp_url($$$$);
27 sub check_unknown_url($$$$);
31 sub check_http_url($$$$)
36 my ($protocol, $host, $path, $file) = @_;
39 if ($protocol eq "http") {
40 $s = Net::HTTP->new(Host => $host, Timeout => 120);
42 elsif ($protocol eq "https") {
43 $s = Net::HTTPS->new(Host => $host, Timeout => 120);
46 print " Unhandled http protocol \"$protocol\"";
65 #print " Trying to use GET => \"$getp\"";
66 $s->write_request(GET => $getp, 'User-Agent' => "Mozilla/6.0");
67 my($code, $mess, %h) = $s->read_response_headers;
69 # Try to read something
71 my $n = $s->read_entity_body($buf, 1024);
73 print " Read from \"$protocol://$host$getp\" failed";
78 # Returns ($err, $isdir)
79 # returns 0, x if file does not match entry
81 # 2, x if not accesible (permission)
82 sub check_ftp_dir_entry($$)
88 #print "Checking '$file' against '$e'\n";
90 $isdir = 1 if ($e =~ /^d/);
91 return(0,$isdir) if ($e !~ /\s$file$/);
92 if ($e =~ /^.[-rwx]{6}([-rwx]{3})\s/) {
96 #print "Invalid entry\n";
100 return(2,$isdir) if ($other !~ /^r/); # not readable
102 #return(2,$isdir) if ($other !~ /x$/); # directory, but not executable
107 sub check_ftp_url($$$$)
111 my ($protocol, $host, $path, $file) = @_;
115 my $ftp = Net::FTP->new($host, Debug => 0, Timeout => 120);
117 return(3,"Cannot connect to $host");
119 if (! $ftp->login("anonymous",'-anonymous@')) {
120 $message = $ftp->message;
126 #print "Path = $path\n";
127 #if (!$ftp->cwd($path)) {
128 # $message = $ftp->message;
131 $rEntries = $ftp->dir($path);
134 $rEntries = $ftp->dir();
138 $message = "Could not read directory \"$path\"";
140 elsif (defined($file)) {
143 for my $f ( @{$rEntries}) {
144 #print "Entry: $path $f\n";
145 my ($res1,$isdir) = check_ftp_dir_entry($file,$f);
151 # found, but not accessible
153 $message = "Permission denied for '$file'";
159 $message = "File or directory '$file' not found";
165 #print "returning ($res,$message)\n";
166 return($res, $message);
169 sub check_unknown_url($$$$)
173 my ($protocol, $host, $path, $file) = @_;
176 my $url = "$protocol://$host";
178 if ($path =~ /^\//) {
186 #print "Trying $url$file\n";
187 $res = head("$url/$file");
189 # try to check for directory '/';
190 #print "Trying $url$file/\n";
191 $res = head("$url/$file/");
195 #print "Trying $url\n";
207 my ($protocol,$host,$path);
211 # Split the url to protocol,host,path
212 if ($url =~ /^([a-z]+):\/\/([^\/]+)(.*)$/) {
217 if($path =~ s/\/([^\/]+)$//) {
220 # Filename contains ' ', maybe invalid. Don't check
227 print " Invalid url '$url'";
230 if ($protocol =~ /^https?$/) {
231 return check_http_url($protocol, $host, $path, $file);
233 elsif ($protocol eq "ftp") {
235 ($res, $message) = check_ftp_url($protocol, $host, $path, $file);
239 # it never should reach this point
240 print " What protocol is '$protocol'?";
241 $res = check_unknown_url($protocol, $host, $path, $file);