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_ftp2_url($$$$)
109 my ($protocol, $host, $path, $file) = @_;
112 print "\nhost $host\n";
113 print "path $path\n";
114 print "file $file\n";
115 my $url = "$protocol://$host";
117 if (defined($file)) {
118 $url = "$url/$path/$file";
121 $url = "$url/$path/.";
123 print "curl $url, file = $file\n";
125 if (open(FFTP, "curl --anyauth -l $url|")) {
126 while (my $l = <FFTP>) {
133 if (! defined($file)) {
136 elsif (defined($listfiles{$file})) {
139 elsif (defined($listfiles{"ftpinfo.txt"})) {
140 return(0, "Probably a directory");
143 return(1, "Not found");
151 sub check_ftp_url($$$$)
155 my ($protocol, $host, $path, $file) = @_;
159 my $ftp = Net::FTP->new($host, Debug => 0, Timeout => 120);
161 return(3,"Cannot connect to $host");
163 if (! $ftp->login("anonymous",'-anonymous@')) {
164 $message = $ftp->message;
170 #print "Path = $path\n";
171 #if (!$ftp->cwd($path)) {
172 # $message = $ftp->message;
175 $rEntries = $ftp->dir($path);
178 $rEntries = $ftp->dir();
182 $message = "Could not read directory \"$path\"";
184 elsif (defined($file)) {
187 for my $f ( @{$rEntries}) {
188 #print "Entry: $path $f\n";
189 my ($res1,$isdir) = check_ftp_dir_entry($file,$f);
195 # found, but not accessible
197 $message = "Permission denied for '$file'";
203 $message = "File or directory '$file' not found";
209 #print "returning ($res,$message)\n";
210 return($res, $message);
213 sub check_unknown_url($$$$)
217 my ($protocol, $host, $path, $file) = @_;
220 my $url = "$protocol://$host";
222 if ($path =~ /^\//) {
230 #print "Trying $url$file\n";
231 $res = head("$url/$file");
233 # try to check for directory '/';
234 #print "Trying $url$file/\n";
235 $res = head("$url/$file/");
239 #print "Trying $url\n";
249 my($url,$use_curl) = @_;
251 my ($protocol,$host,$path);
255 # Split the url to protocol,host,path
256 if ($url =~ /^([a-z]+):\/\/([^\/]+)(.*)$/) {
261 if($path =~ s/\/([^\/]+)$//) {
264 # Filename contains ' ', maybe invalid. Don't check
271 print " Invalid url '$url'";
274 if ($protocol =~ /^https?$/) {
275 return check_http_url($protocol, $host, $path, $file);
277 elsif ($protocol eq "ftp") {
280 ($res, $message) = check_ftp2_url($protocol, $host, $path, $file);
283 ($res, $message) = check_ftp_url($protocol, $host, $path, $file);
288 # it never should reach this point
289 print " What protocol is '$protocol'?";
290 $res = check_unknown_url($protocol, $host, $path, $file);