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\" ";
76 if ($buf =~ /\<title\>Error 404\<\/title\>/) {
77 print " Page reports 'Error 404' from \"$protocol://$host$getp\" ";
83 # Returns ($err, $isdir)
84 # returns 0, x if file does not match entry
86 # 2, x if not accesible (permission)
87 sub check_ftp_dir_entry($$)
93 #print "Checking '$file' against '$e'\n";
95 $isdir = 1 if ($e =~ /^d/);
96 return(0,$isdir) if ($e !~ /\s$file$/);
97 if ($e =~ /^.[-rwx]{6}([-rwx]{3})\s/) {
101 #print "Invalid entry\n";
105 return(2,$isdir) if ($other !~ /^r/); # not readable
107 #return(2,$isdir) if ($other !~ /x$/); # directory, but not executable
112 sub check_ftp_url($$$$)
116 my ($protocol, $host, $path, $file) = @_;
120 my $ftp = Net::FTP->new($host, Debug => 0, Timeout => 120);
122 return(3,"Cannot connect to $host");
124 if (! $ftp->login("anonymous",'-anonymous@')) {
125 $message = $ftp->message;
131 #print "Path = $path\n";
132 #if (!$ftp->cwd($path)) {
133 # $message = $ftp->message;
136 $rEntries = $ftp->dir($path);
139 $rEntries = $ftp->dir();
143 $message = "Could not read directory \"$path\"";
145 elsif (defined($file)) {
148 for my $f ( @{$rEntries}) {
149 #print "Entry: $path $f\n";
150 my ($res1,$isdir) = check_ftp_dir_entry($file,$f);
156 # found, but not accessible
158 $message = "Permission denied for '$file'";
164 $message = "File or directory '$file' not found";
170 #print "returning ($res,$message)\n";
171 return($res, $message);
174 sub check_unknown_url($$$$)
178 my ($protocol, $host, $path, $file) = @_;
181 my $url = "$protocol://$host";
183 if ($path =~ /^\//) {
191 #print "Trying $url$file\n";
192 $res = head("$url/$file");
194 # try to check for directory '/';
195 #print "Trying $url$file/\n";
196 $res = head("$url/$file/");
200 #print "Trying $url\n";
212 my ($protocol,$host,$path);
216 # Split the url to protocol,host,path
217 if ($url =~ /^([a-z]+):\/\/([^\/]+)(.*)$/) {
222 if($path =~ s/\/([^\/]+)$//) {
225 # Filename contains ' ', maybe invalid. Don't check
232 print " Invalid url '$url'";
235 if ($protocol =~ /^https?$/) {
236 return check_http_url($protocol, $host, $path, $file);
238 elsif ($protocol eq "ftp") {
240 ($res, $message) = check_ftp_url($protocol, $host, $path, $file);
244 # it never should reach this point
245 print " What protocol is '$protocol'?";
246 $res = check_unknown_url($protocol, $host, $path, $file);