Attachment #174865 for bug #328003

View | Details | Raw Unified | Return to bug 328003
Collapse All | Expand All




}

#==========================================
# checkContentFile
#------------------------------------------
sub checkContentData {
	my $this    = shift;
	my $location= shift;
	my $content = shift;
	my $pattern = shift;
	my $arch    = $this->{arch};
	#==========================================
	# check content: DESCRDIR...
	#------------------------------------------
	my $perr   = 1;
	my @plines = split (/\n/,$content);
	foreach my $line (@plines) {
		if ($line =~ /DESCRDIR (.*)/) {
			$location = $location."/".$1;
			$perr = 0;
			last;
		}
	}
	if ($perr) {
		return undef;
	}
	#===========================================
	# check content: pattern file...
	#-------------------------------------------
	$perr = 1;
	$this->{pzip} = 0;
	foreach my $line (@plines) {
		if ($line =~ / ($pattern-.*$arch\.pat\.gz)/) {
			$location = $location."/".$1;
			$this->{pzip} = 1;
			$perr = 0;
			last;
		}
		if ($line =~ / ($pattern-.*$arch\.pat)/) {
			$location = $location."/".$1;
			$this->{pzip} = 0;
			$perr = 0;
			last;
		}
	}
	if ($perr) {
		return undef;
	}
	return $location;
}

#==========================================
# downloadPattern
#------------------------------------------
sub downloadPattern {

		#==========================================
		# local pattern check
		#------------------------------------------
		my $cfile = $url."/content";
		if (! -f $cfile) {
		if (! @file) {
			@file = bsd_glob ("$path/$pattern-*.$arch.pat.gz");
		}
		if (! @file) {
			return (undef,
				"Couldn't find content file: $cfile"
			);
			if (! open (FD,$cfile)) {
				return (undef,"Couldn't open content file: $cfile: $!");
			# / FIXME /
			# The glob match will include the -32bit patterns in any
			# case. Is that ok or not ? should it be configurable ?
			# ---
			if ($file =~ /\.gz$/) {
				if (! open (FD,"cat $file | gzip -cd|")) {
					return (undef,"Couldn't uncompress pattern: $file: $!");
				}
			} else {
				if (! open (FD,$file)) {
					return (undef,"Couldn't open pattern: $file: $!");
				}
			}
			local $/; $content .= <FD>; close FD;
		}
		#==========================================
		# check content file
		#------------------------------------------
		my $pfile = $this -> checkContentData ($url,$content,$pattern);
		if (! defined $pfile) {
			#===========================================
			# no content file but local, try glob search
			#-------------------------------------------
			my $path = "$url//suse/setup/descr";
			my @file = bsd_glob ("$path/$pattern-*.$arch.pat");
			if (! @file) {
				@file = bsd_glob ("$path/$pattern-*.$arch.pat.gz");
			}
			if (! @file) {
				return (undef,
					"Pattern glob match failed: $pattern"
				);
			}
			$pfile = $file[0];
		}
		#==========================================
		# finally get the pattern
		#------------------------------------------
		if ($pfile =~ /\.gz$/) {
			if (! open (FD,"cat $pfile | gzip -cd|")) {
				return (undef,"Couldn't uncompress pattern: $pfile: $!");
			}
		} else {
			if (! open (FD,$pfile)) {
				return (undef,"Couldn't open pattern: $pfile: $!");
			}
		}
		local $/; $content .= <FD>;
		close FD;
	} else {
		#==========================================
		# remote pattern check

			$publics_url = $highlvl_url;
		}
		my $browser  = LWP::UserAgent->new;
		my $location = $publics_url."/content";
		my $request  = HTTP::Request->new (GET => $location);
		my $response = $browser  -> request ( $request );
		my $title    = $response -> title ();
		$content     = $response -> content ();
		if (! defined $content) {
			return (undef,"Failed to load content file: $location");
			$request  = HTTP::Request->new (GET => $location);
			$response = $browser  -> request ( $request );
			$title    = $response -> title ();
			$content  = $response -> content ();
			if ($title =~ /not found/i) {
				return (undef,"Page not found: $location");
			}
		}
		#==========================================
		# check content file
		#------------------------------------------
		$location = $this -> checkContentData ($publics_url,$content,$pattern);
		if (! defined $location) {
		if ($content !~ /\"($pattern-.*$arch\.pat)\"/) {
			if ($content !~ /\"($pattern-.*$arch\.pat\.gz)\"/) {
				$perr = 1;
			} else {
				$location = $location."/".$1;
				$pzip = 1;
			}
		} else {
			$location = $location."/".$1;
		}
		#==========================================
		# check for ftp pages next...
		#------------------------------------------
		if ($perr) {
			my @plines = split (/\n/,$content);
			foreach my $line (@plines) {
				if ($line =~ / ($pattern-.*$arch\.pat\.gz)/) {
					$location = $location."/".$1;
					$pzip = 1; $perr = 0;
					last;
				}
				if ($line =~ / ($pattern-.*$arch\.pat)/) {
					$location = $location."/".$1;
					$pzip = 0; $perr = 0;
					last;
				}
			}
		}
		if ($perr) {
			return (undef,
				"Pattern match or DESCRDIR search failed: $pattern"
			);
		}
		#==========================================

		$request  = HTTP::Request->new (GET => $location);
		$response = $browser  -> request ( $request );
		$content  = $response -> content ();
		if ($this->{pzip}) {
			my $tmpdir = qx ( mktemp -q -d /tmp/kiwipattern.XXXXXX );
			my $result = $? >> 8;
			chomp $tmpdir;

Return to bug 328003

Lines 148-153 Link Here

(-)modules/KIWIPattern.pm (-66 / +96 lines)
148	}	148	}
149		149
150	#==========================================	150	#==========================================
		151	# checkContentFile
		152	#------------------------------------------
		153	sub checkContentData {
		154	my $this = shift;
		155	my $location= shift;
		156	my $content = shift;
		157	my $pattern = shift;
		158	my $arch = $this->{arch};
		159	#==========================================
		160	# check content: DESCRDIR...
		161	#------------------------------------------
		162	my $perr = 1;
		163	my @plines = split (/\n/,$content);
		164	foreach my $line (@plines) {
		165	if ($line =~ /DESCRDIR (.*)/) {
		166	$location = $location."/".$1;
		167	$perr = 0;
		168	last;
		169	}
		170	}
		171	if ($perr) {
		172	return undef;
		173	}
		174	#===========================================
		175	# check content: pattern file...
		176	#-------------------------------------------
		177	$perr = 1;
		178	$this->{pzip} = 0;
		179	foreach my $line (@plines) {
		180	if ($line =~ / ($pattern-.*$arch\.pat\.gz)/) {
		181	$location = $location."/".$1;
		182	$this->{pzip} = 1;
		183	$perr = 0;
		184	last;
		185	}
		186	if ($line =~ / ($pattern-.*$arch\.pat)/) {
		187	$location = $location."/".$1;
		188	$this->{pzip} = 0;
		189	$perr = 0;
		190	last;
		191	}
		192	}
		193	if ($perr) {
		194	return undef;
		195	}
		196	return $location;
		197	}
		198
		199	#==========================================
151	# downloadPattern	200	# downloadPattern
152	#------------------------------------------	201	#------------------------------------------
153	sub downloadPattern {	202	sub downloadPattern {
Lines 164-195 Link Here
164	#==========================================	213	#==========================================
165	# local pattern check	214	# local pattern check
166	#------------------------------------------	215	#------------------------------------------
167	my $path = "$url//suse/setup/descr";	216	my $cfile = $url."/content";
168	my @file = bsd_glob ("$path/$pattern-*.$arch.pat");	217	if (! -f $cfile) {
169	if (! @file) {
170	@file = bsd_glob ("$path/$pattern-*.$arch.pat.gz");
171	}
172	if (! @file) {
173	return (undef,	218	return (undef,
174	"Couldn't find pat by glob: \<$path/$pattern-*.$arch.pat\>"	219	"Couldn't find content file: $cfile"
175	);	220	);
176	}	221	if (! open (FD,$cfile)) {
177	foreach my $file (@file) {	222	return (undef,"Couldn't open content file: $cfile: $!");
178	# / FIXME /
179	# The glob match will include the -32bit patterns in any
180	# case. Is that ok or not ? should it be configurable ?
181	# ---
182	if ($file =~ /\.gz$/) {
183	if (! open (FD,"cat $file \| gzip -cd\|")) {
184	return (undef,"Couldn't uncompress pattern: $file: $!");
185	}
186	} else {
187	if (! open (FD,$file)) {
188	return (undef,"Couldn't open pattern: $file: $!");
189	}
190	}	223	}
191	local $/; $content .= <FD>; close FD;	224	local $/; $content .= <FD>; close FD;
192	}	225	}
		226	#==========================================
		227	# check content file
		228	#------------------------------------------
		229	my $pfile = $this -> checkContentData ($url,$content,$pattern);
		230	if (! defined $pfile) {
		231	#===========================================
		232	# no content file but local, try glob search
		233	#-------------------------------------------
		234	my $path = "$url//suse/setup/descr";
		235	my @file = bsd_glob ("$path/$pattern-*.$arch.pat");
		236	if (! @file) {
		237	@file = bsd_glob ("$path/$pattern-*.$arch.pat.gz");
		238	}
		239	if (! @file) {
		240	return (undef,
		241	"Pattern glob match failed: $pattern"
		242	);
		243	}
		244	$pfile = $file[0];
		245	}
		246	#==========================================
		247	# finally get the pattern
		248	#------------------------------------------
		249	if ($pfile =~ /\.gz$/) {
		250	if (! open (FD,"cat $pfile \| gzip -cd\|")) {
		251	return (undef,"Couldn't uncompress pattern: $pfile: $!");
		252	}
		253	} else {
		254	if (! open (FD,$pfile)) {
		255	return (undef,"Couldn't open pattern: $pfile: $!");
		256	}
		257	}
		258	local $/; $content .= <FD>;
		259	close FD;
193	} else {	260	} else {
194	#==========================================	261	#==========================================
195	# remote pattern check	262	# remote pattern check
Lines 201-257 Link Here
201	$publics_url = $highlvl_url;	268	$publics_url = $highlvl_url;
202	}	269	}
203	my $browser = LWP::UserAgent->new;	270	my $browser = LWP::UserAgent->new;
204	my $location = $publics_url."/setup/descr";	271	my $location = $publics_url."/content";
205	my $request = HTTP::Request->new (GET => $location);	272	my $request = HTTP::Request->new (GET => $location);
206	my $response = $browser -> request ( $request );	273	my $response = $browser -> request ( $request );
207	my $title = $response -> title ();
208	$content = $response -> content ();	274	$content = $response -> content ();
209	if ((! defined $title) \|\| ($title =~ /not found/i)) {	275	if (! defined $content) {
210	$location = $publics_url."/suse/setup/descr";	276	return (undef,"Failed to load content file: $location");
211	$request = HTTP::Request->new (GET => $location);
212	$response = $browser -> request ( $request );
213	$title = $response -> title ();
214	$content = $response -> content ();
215	if ($title =~ /not found/i) {
216	return (undef,"Page not found: $location");
217	}
218	}	277	}
219	#==========================================	278	#==========================================
220	# check for http pages first...	279	# check content file
221	#------------------------------------------	280	#------------------------------------------
222	my $pzip = 0;	281	$location = $this -> checkContentData ($publics_url,$content,$pattern);
223	my $perr = 0;	282	if (! defined $location) {
224	if ($content !~ /\"($pattern-.*$arch\.pat)\"/) {
225	if ($content !~ /\"($pattern-.*$arch\.pat\.gz)\"/) {
226	$perr = 1;
227	} else {
228	$location = $location."/".$1;
229	$pzip = 1;
230	}
231	} else {
232	$location = $location."/".$1;
233	}
234	#==========================================
235	# check for ftp pages next...
236	#------------------------------------------
237	if ($perr) {
238	my @plines = split (/\n/,$content);
239	foreach my $line (@plines) {
240	if ($line =~ / ($pattern-.*$arch\.pat\.gz)/) {
241	$location = $location."/".$1;
242	$pzip = 1; $perr = 0;
243	last;
244	}
245	if ($line =~ / ($pattern-.*$arch\.pat)/) {
246	$location = $location."/".$1;
247	$pzip = 0; $perr = 0;
248	last;
249	}
250	}
251	}
252	if ($perr) {
253	return (undef,	283	return (undef,
254	"Couldn't find pat by regexp: /$pattern-.*$arch\.pat/"	284	"Pattern match or DESCRDIR search failed: $pattern"
255	);	285	);
256	}	286	}
257	#==========================================	287	#==========================================
Lines 260-266 Link Here
260	$request = HTTP::Request->new (GET => $location);	290	$request = HTTP::Request->new (GET => $location);
261	$response = $browser -> request ( $request );	291	$response = $browser -> request ( $request );
262	$content = $response -> content ();	292	$content = $response -> content ();
263	if ($pzip) {	293	if ($this->{pzip}) {
264	my $tmpdir = qx ( mktemp -q -d /tmp/kiwipattern.XXXXXX );	294	my $tmpdir = qx ( mktemp -q -d /tmp/kiwipattern.XXXXXX );
265	my $result = $? >> 8;	295	my $result = $? >> 8;
266	chomp $tmpdir;	296	chomp $tmpdir;