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($$$$)
33 require LWP::UserAgent;
35 my ($protocol, $host, $path, $file) = @_;
37 my $ua = LWP::UserAgent->new;
51 $ua->agent("Firefox/43.0");
52 my $response = $ua->get("$protocol://$host$getp");
53 if ($response->is_success) {
54 $buf = $response->decoded_content;
57 print " " . $response->status_line . ": ";
62 while ($buf =~ s/\<title\>([^\<]*)\<\/title\>//i) {
64 $title =~ s/[\r\n]/ /g;
69 print "title = \"$title\": ";
70 if ($title =~ /Error 404|Not Found/) {
71 print " Page reports 'Not Found' from \"$protocol://$host$getp\": ";
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);