X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=bin%2Fextract_files;h=a94fba06bd87d5a3161fdde213935392cb6d086f;hp=c129153c7b26674e409cb8df21e478de5e52bff7;hb=aad6264acf766c330147186c7b3a48f4683721db;hpb=e8a26d279e317b51711d99ed6af1aafb1d0ceef2 diff --git a/bin/extract_files b/bin/extract_files index c129153..a94fba0 100755 --- a/bin/extract_files +++ b/bin/extract_files @@ -1,7 +1,7 @@ #!/usr/bin/perl # # Script to extract files from Debian packages -# Copyright 2004 Frank Lichtenheld +# Copyright 2004-2007 Frank Lichtenheld # # based on a shell script which was # Copyright 2003 Noel Köthe @@ -19,7 +19,7 @@ # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; use warnings; @@ -130,30 +130,31 @@ sub add_log { $$log .= localtime().": @_\n"; } +sub touch { + my $filename = shift; + sysopen(H, $filename, O_WRONLY|O_NONBLOCK|O_CREAT) or return undef; + close(H); + return 1; +} + ################################################## # PACKAGE HANDLING (UNPACKING/CLEANUP) sub unpack_srcpkg { - my ( $dscname, $log ) = @_; + my ( $pkgname, $dscname, $log ) = @_; chdir( $TEMPDIR ) or do_error( "couldn't change working directory to $TEMPDIR" ); - add_log( $log, "dpkg-source -sn -x $dscname" ); + add_log( $log, "dpkg-source -sn -x $dscname $pkgname+source" ); - my $out = qx/dpkg-source -sn -x "$dscname" 2>&1/; - my ($dir) = ($out =~ /(\S+)$/mo); - - add_log( $log, "dpkg-source output: ", $out ); - -#Bug#246802 -# system("dpkg-source", "-x", $dscname ) == 0 -# or do { -# do_warning( "couldn't unpack $dscname" ); -# add_log( $log, "couldn't unpack $dscname" ); -# return; -# }; + system("dpkg-source", "-sn", "-x", $dscname, "$pkgname+source" ) == 0 + or do { + do_warning( "couldn't unpack $dscname: $!" ); + add_log( $log, "couldn't unpack $dscname: $!" ); + return; + }; - return $dir; + return "$pkgname+source"; } sub unpack_binpkg { @@ -233,8 +234,8 @@ sub to_update { if ($config_data->{structure} == PKGPOOL) { my $dir = "$target/".pkg_pool_directory( $pkg_data ); - if (!$force && -d $dir && -f "$dir/log") { - (system( "touch", "$dir/log" ) == 0) + if (!$force && -f "$dir/log") { + (utime(undef,undef,"$dir/log") == 1) or do_warning( "touch of $dir/log failed" ); return 0; } else { @@ -290,7 +291,7 @@ sub extract_copyright_to_pkgpool { my $pkg2 = $1; if ($pkg_data->{bin_list}{$pkg2}) { add_log( $log, "symlink points to $pkg2, make symlink to copyright file" ); - (system("ln", "-s", "$pkg2.copyright", $tgt ) == 0) + (symlink( "$pkg2.copyright", $tgt ) == 1 ) or add_log( $log, "symlink creation failed" ); } else { add_log( $log, "symlink points to $pkg2, don't know what to do with that" ); @@ -304,11 +305,11 @@ sub extract_copyright_to_pkgpool { add_log( $log, "copyright file $tgt still doesn't exist" ); if (-e $src_tgt) { add_log( $log, "copyright file of the source package exists, make symlink" ); - (system("ln", "-s", "copyright", $tgt ) == 0) + (symlink( "copyright", $tgt ) == 1 ) or add_log( $log, "symlink generation failed" ); } else { add_log( $log, "give up on $bin_pkg" ); - (system( "touch", "$tgt.ERROR" ) == 0) + touch("$tgt.ERROR") or add_log( $log, "even the touch of $tgt.ERROR failed :(" ); } } @@ -323,7 +324,7 @@ sub extract_copyright_to_pkgpool { keys %{$pkg_data->{bin_list}})) { if (-e "$target_dir/$bin_pkg.copyright") { add_log( $log, "copyright file $target_dir/$bin_pkg.copyright seems like a good guess to me, make a symlink" ); - (system("ln", "-s", "$bin_pkg.copyright", $src_tgt ) == 0) + (symlink( "$bin_pkg.copyright", $src_tgt ) == 1 ) or do { add_log( $log, "symlink generation failed" ); next; @@ -333,7 +334,7 @@ sub extract_copyright_to_pkgpool { } unless (-e $src_tgt) { add_log( $log, "give up" ); - (system( "touch", "$src_tgt.ERROR" ) == 0) or + touch("$src_tgt.ERROR") or add_log( $log, "even the touch of $src_tgt.ERROR failed :(" ); } } @@ -377,7 +378,7 @@ sub manage_current_link { unless (-l $current_link) { add_log( $log, "create new current link" ); (chdir( $parent_dir ) and - not system( 'ln', '-s', $dirname, 'current' )) or + (symlink( $dirname, 'current' ) == 1 )) or add_log( $log, "creating new current link failed: $!" ); } else { my $old_target = readlink( $current_link ); @@ -388,7 +389,7 @@ sub manage_current_link { "old_version=$old_version; overwriting current link" ); (chdir( $parent_dir ) and unlink( 'current' ) and - not system( 'ln', '-s', $dirname, 'current' )) or + (symlink( $dirname, 'current' ) == 1 )) or add_log( $log, "overwriting current link failed: $!" ); } else { add_log( $log, @@ -409,7 +410,7 @@ sub extract_files { return; } - if (my $source_dir = unpack_srcpkg( $pkg_data->{dsc}, \$log )) { + if (my $source_dir = unpack_srcpkg( $pkg_data->{src_name}, $pkg_data->{dsc}, \$log )) { $source_dir = "$TEMPDIR/$source_dir"; @@ -563,6 +564,10 @@ sub read_deb { } } $cache{$debname} ||= qx/dpkg-deb --info "$debname" control/; + unless ( $cache{$debname} ) { + do_warning( "extracting control information of file $debname failed" ); + return; + } my $control = $cache{$debname}; unless ( $raw_data = $parser->parse_mem( $control, @@ -606,7 +611,7 @@ sub collect_deb { return unless $pkg_data; if (exists $bin_packages{$pkg_data->{bin_name}}{$pkg_data->{bin_version}}{$pkg_data->{bin_arch}}) { - do_warning( "duplicated package $pkg_data->{bin_name}, version {$pkg_data->{bin_version}{$pkg_data->{bin_arch}}" ); + do_warning( "duplicated package $pkg_data->{bin_name}, version $pkg_data->{bin_version}, arch $pkg_data->{bin_arch}" ); return; } else { $bin_packages{$pkg_data->{bin_name}}{$pkg_data->{bin_version}}{$pkg_data->{bin_arch}} = $pkg_data;