From eaf1f7e94354b3bf37db6864de8364ffbda223f7 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Sun, 10 Oct 1999 13:03:27 +0000 Subject: no_comment --- perl-install/.cvsignore | 3 ++ perl-install/Makefile | 41 ++++++---------- perl-install/c.pm | 12 +++++ perl-install/c/Makefile | 2 +- perl-install/commands | 2 +- perl-install/install2 | 2 +- perl-install/resize_fat/.cvsignore | 5 ++ perl-install/resize_fat/Makefile | 16 +++--- perl-install/resize_fat/Makefile.PL | 13 +++++ perl-install/resize_fat/any.pm | 16 +++--- perl-install/resize_fat/c_rewritten.pm | 14 ++++++ perl-install/resize_fat/c_rewritten.xs | 90 ++++++++++++++++++++++++++++++++++ perl-install/resize_fat/dir_entry.pm | 7 +-- perl-install/resize_fat/directory.pm | 5 +- perl-install/resize_fat/fat.pm | 28 +++++------ perl-install/resize_fat/main.pm | 6 +-- 16 files changed, 188 insertions(+), 74 deletions(-) create mode 100644 perl-install/c.pm create mode 100644 perl-install/resize_fat/.cvsignore create mode 100644 perl-install/resize_fat/Makefile.PL create mode 100644 perl-install/resize_fat/c_rewritten.pm create mode 100644 perl-install/resize_fat/c_rewritten.xs (limited to 'perl-install') diff --git a/perl-install/.cvsignore b/perl-install/.cvsignore index 125d80f93..a188a911a 100644 --- a/perl-install/.cvsignore +++ b/perl-install/.cvsignore @@ -4,4 +4,7 @@ modparm.lst locales.tar.bz2 debug.log auto_inst.cfg +auto +gendepslist +t.pm perl diff --git a/perl-install/Makefile b/perl-install/Makefile index 90f4a88f6..6fd9061db 100644 --- a/perl-install/Makefile +++ b/perl-install/Makefile @@ -1,16 +1,17 @@ VERSION = 2.2.10-BOOT SUDO = sudo SO_FILES = c/blib/arch/auto/c/c.so -PMS = *.pm c/*.pm resize_fat/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake g_auto_install +PMS = *.pm c/stuff.pm resize_fat/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake g_auto_install +REP4PMS = /usr/bin/perl-install ROOTDEST = /export DEST = $(ROOTDEST)/Mandrake/mdkinst STAGE2 = $(ROOTDEST)/Mandrake/base/mdkinst_stage2 BASE = $(ROOTDEST)/Mandrake/base -DESTREP4PMS = $(DEST)/usr/bin/perl-install +DESTREP4PMS = $(DEST)$(REP4PMS) STAGE2TMP = /tmp/stage2_tmp PERL = perl LOCALFILES = $(PERL) mouseconfig ddcxinfos -DIRS = po pci_probing +DIRS = c po pci_probing resize_fat EXCLUDE = $(LOCALFILES) boot.img keymaps consolefonts install RPMS = $(wildcard $(ROOTDEST)/Mandrake/RPMS/*.rpm) CFLAGS = -Wall @@ -18,15 +19,14 @@ override CFLAGS += -pipe .PHONY: all $(DIRS) tags install clean stage2 full_stage2 verify_c -all: $(SO_FILES) $(DIRS) +all: $(DIRS) tags: etags -o - $(PMS) | ./perl2etags > TAGS clean: - test ! -e c/Makefile || $(MAKE) -C c clean for i in $(DIRS); do $(MAKE) -C $$i clean; done - rm -rf c/c.xs gendepslist ../diskdrake* + rm -rf gendepslist auto ../diskdrake* find . -name "*~" -o -name "TAGS" -o -name "*.old" | xargs rm -f tar: clean @@ -47,16 +47,8 @@ tar-XFdrake: clean l=`./perl2fcalls -uses -excludec -excludepci_probing::ids XFdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/XFdrake\//' -e 's/$$/.pm/'` ; \ cd .. ; tar cfz XFdrake.tgz --exclude CVS $(patsubst %,XFdrake/%,c MonitorsDB po pci_probing XFdrake*) $$l -c/c.xs: c/c.xs.pm - rm -f $@ - export C_RPM=1 ; perl $< > $@ - chmod a-w $@ - -$(SO_FILES): c/c.xs - test -e c/Makefile || (cd c; export C_RPM=1 ; perl Makefile.PL) - $(MAKE) -C c - $(DIRS): + install -d auto $(MAKE) -C $@ test_pms: verify_c @@ -76,7 +68,7 @@ $(BASE)/depslist: gendepslist $(RPMS) $(BASE)/hdlist: $(RPMS) $(ROOTDEST)/misc/genhdlist $(ROOTDEST) -install_pms: all +install_pms: $(DIRS) for i in `perl -ne 's/sub (\w+?)_? {.*/$$1/ and print' commands.pm`; do ln -sf commands $(DEST)/usr/bin/$$i; done install -d $(DESTREP4PMS) @@ -88,9 +80,6 @@ install_pms: all # perl -ne 's/\s*#-.*//; print unless (/^=head/ .. /^=cut/) || /use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \ # / - rm $(DESTREP4PMS)/c/c.xs.pm - mv -f $(DESTREP4PMS)/c/c.pm $(DESTREP4PMS) - cp *.rc $(DESTREP4PMS) install -d $(DESTREP4PMS)/po cp po/*.po* $(DESTREP4PMS)/po @@ -101,13 +90,12 @@ install_pms: all chmod a+x $(DESTREP4PMS)/XFdrake chmod a+x $(DESTREP4PMS)/g_auto_install - cp -af */blib/arch/auto $(DESTREP4PMS) - find $(DESTREP4PMS) -name "*.so" | xargs strip - -get_needed_files: $(SO_FILES) +get_needed_files: $(DIRS) # export PERL_INSTALL_TEST=1 ; strace -f -e trace=file -o '| grep -v "(No such file or directory)" | sed -e "s/[^\"]*\"//" -e "s/\".*//" | grep "^/" | grep -v -e "^/tmp" -e "^/home" -e "^/proc" -e "^/var" -e "^/dev" -e "^/etc" -e "^/usr/lib/rpm" > /tmp/list ' $(PERL) -d install2 < /dev/null cp -f list /tmp/list - for i in c/blib/arch/auto/c/c.so $(LOCALFILES) `cat /tmp/list` ; do \ + ls auto/*/*/*.so >> /tmp/list + + for i in $(LOCALFILES) `cat /tmp/list` ; do \ ldd $$i 2>/dev/null | grep -v "not a dynamic" | sed -e 's/.*=> //' -e 's/ .*//' | uniq | sort >> /tmp/list; \ done @@ -125,13 +113,14 @@ get_needed_files: $(SO_FILES) if (echo $$i | grep -q "lib/[^/]*\.so"); then \ install -s $$i $(DEST)/lib; \ else \ - d=`echo $(DEST)/$$i | sed 's/\/usr\/local\//\/usr\//'`; \ + d=$$i; \ + (echo $$d | grep -q "^[^/]") && d="$(REP4PMS)/$$d"; \ + d=`echo $(DEST)/$$d | sed 's/\/usr\/local\//\/usr\//'`; \ install -d `dirname $$d` && \ if (echo $$i | grep -q "\.pm"); then \ perl -pe '$$_ =~ /^__END__/ and exit(0);' $$i > $$d; \ else \ cp -f $$i $$d; \ - strip $$d 2>/dev/null || true; \ fi; \ fi; \ done diff --git a/perl-install/c.pm b/perl-install/c.pm new file mode 100644 index 000000000..e2cfe0428 --- /dev/null +++ b/perl-install/c.pm @@ -0,0 +1,12 @@ +package c; + +use vars qw($AUTOLOAD); + +use c::stuff; + +sub AUTOLOAD { + $AUTOLOAD =~ /::(.*)/; + goto &{$c::stuff::{$1}}; +} + +1; diff --git a/perl-install/c/Makefile b/perl-install/c/Makefile index dcd777bb7..16f42def5 100644 --- a/perl-install/c/Makefile +++ b/perl-install/c/Makefile @@ -3,7 +3,7 @@ stuff: %: %.xs test -e Makefile_c || C_RPM=1 perl Makefile.PL $(MAKE) -f Makefile_c - ln -sf ../c/blib/arch/auto ../auto/c + rm ../auto/c ; ln -s ../c/blib/arch/auto ../auto/c clean: test ! -e Makefile_c || $(MAKE) -f Makefile_c clean diff --git a/perl-install/commands b/perl-install/commands index e00f215de..edd22bb5f 100755 --- a/perl-install/commands +++ b/perl-install/commands @@ -3,7 +3,7 @@ use diagnostics; use strict; -use lib qw(/usr/bin/perl-install . c c/blib/arch); +use lib qw(/usr/bin/perl-install .); use common qw(:file); use commands; diff --git a/perl-install/install2 b/perl-install/install2 index b9459d527..94b64f271 100755 --- a/perl-install/install2 +++ b/perl-install/install2 @@ -20,7 +20,7 @@ use diagnostics; use strict; -use lib qw(/usr/bin/perl-install . c c/blib/arch); +use lib qw(/usr/bin/perl-install .); use install2; $::testing = $ENV{PERL_INSTALL_TEST}; diff --git a/perl-install/resize_fat/.cvsignore b/perl-install/resize_fat/.cvsignore new file mode 100644 index 000000000..3001c7424 --- /dev/null +++ b/perl-install/resize_fat/.cvsignore @@ -0,0 +1,5 @@ +blib +pm_to_blib +Makefile_c +c_rewritten.c +c_rewritten.bs diff --git a/perl-install/resize_fat/Makefile b/perl-install/resize_fat/Makefile index 34c257a4e..4b41e1bef 100644 --- a/perl-install/resize_fat/Makefile +++ b/perl-install/resize_fat/Makefile @@ -1,12 +1,10 @@ -PRODUCT = libresize -TARSOURCE = $(PRODUCT).tar.bz2 +.PHONY: clean -.PHONY: clean tar +c_rewritten: %: %.xs + test -e Makefile_c || perl Makefile.PL + $(MAKE) -f Makefile_c + rm ../auto/resize_fat ; ln -s ../resize_fat/blib/arch/auto ../auto/resize_fat clean: - rm -f *~ TAGS $(TARSOURCE) - -tar: clean - cp -f ../common.pm . - cd .. ; tar cfy $(TARSOURCE) $(PRODUCT) ; mv $(TARSOURCE) $(PRODUCT) - rm -f common.pm + test ! -e Makefile_c || $(MAKE) -f Makefile_c clean + rm -f *~ diff --git a/perl-install/resize_fat/Makefile.PL b/perl-install/resize_fat/Makefile.PL new file mode 100644 index 000000000..712f4e395 --- /dev/null +++ b/perl-install/resize_fat/Makefile.PL @@ -0,0 +1,13 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. + +WriteMakefile( + 'MAKEFILE' => 'Makefile_c', + 'NAME' => 'c_rewritten', + 'OPTIMIZE' => '-Os', + 'VERSION_FROM' => 'c_rewritten.pm', # finds $VERSION + 'LIBS' => '', # e.g., '-lm' + 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' + 'INC' => '', # e.g., '-I/usr/include/other' +); diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm index 6acd0b52c..7d7d006fa 100644 --- a/perl-install/resize_fat/any.pm +++ b/perl-install/resize_fat/any.pm @@ -57,7 +57,8 @@ sub max_size($) { #- Each FAT entry is flagged as either FREE, FILE or DIRECTORY. sub flag_clusters { my ($fs) = @_; - my ($cluster, $entry, $type); + my ($cluster, $entry, $type, $nb_dirs); + my $fat_flag_map = "\0" x ($fs->{nb_clusters} + 2); my $f = sub { ($entry) = @_; @@ -69,14 +70,11 @@ sub flag_clusters { $type = $DIRECTORY; } else { return } - for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next($fs, $cluster)) { - $cluster == 0 and die "Bad FAT: unterminated chain for $entry->{name}\n"; - $fs->{fat_flag_map}[$cluster] and die "Bad FAT: cluster $cluster is cross-linked for $entry->{name}\n"; - $fs->{fat_flag_map}[$cluster] = $type; - $fs->{clusters}{count}{dirs}++ if $type == $DIRECTORY; - } + my $nb = resize_fat::c_rewritten::checkFat($fat_flag_map, $cluster, $type, $entry->{name}); + $nb_dirs += $nb if $type == $DIRECTORY; + 0; }; - $fs->{fat_flag_map} = [ ($FREE) x ($fs->{nb_clusters} + 2) ]; - $fs->{clusters}{count}{dirs} = 0; resize_fat::directory::traverse_all($fs, $f); + $fs->{fat_flag_map} = $fat_flag_map; + $fs->{clusters}{count}{dirs} = $nb_dirs; } diff --git a/perl-install/resize_fat/c_rewritten.pm b/perl-install/resize_fat/c_rewritten.pm new file mode 100644 index 000000000..1f5f505c7 --- /dev/null +++ b/perl-install/resize_fat/c_rewritten.pm @@ -0,0 +1,14 @@ +package resize_fat::c_rewritten; + +use strict; +use vars qw($VERSION @ISA); + +require DynaLoader; + +@ISA = qw(DynaLoader); +$VERSION = '0.01'; + +bootstrap resize_fat::c_rewritten $VERSION; + +1; + diff --git a/perl-install/resize_fat/c_rewritten.xs b/perl-install/resize_fat/c_rewritten.xs new file mode 100644 index 000000000..a42f3d133 --- /dev/null +++ b/perl-install/resize_fat/c_rewritten.xs @@ -0,0 +1,90 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* set by scan_fat, used by next */ +short *fat = NULL; +int type_size, nb_clusters, bad_cluster_value; +char *fat_flag_map; + +unsigned int next(unsigned int cluster) { + short *p = fat + type_size * cluster; + if (cluster > nb_clusters + 2) croak("fat::next: cluster %d outside filesystem", cluster); + return type_size == 1 ? *p : *((unsigned int *) p); +} + +MODULE = resize_fat::c_rewritten PACKAGE = resize_fat::c_rewritten + +void +scan_fat(fat_, nb_clusters_, type_size_) + char *fat_ + int nb_clusters_ + int type_size_ + PPCODE: + unsigned int v; + int free = 0, bad = 0, used = 0; + short *p; + + fat = (short*) fat_; type_size = type_size_; nb_clusters = nb_clusters_; + bad_cluster_value = type_size ? 0xffffff7 : 0xfff7; + + if (type_size % 16) fprintf(stderr, "unable to handle type_size"), exit(1); + type_size /= 16; + + for (p = fat + 2 * type_size; p < fat + type_size * (nb_clusters + 2); p += type_size) { + v = type_size == 1 ? *p : *((unsigned int *) p); + + if (v == 0) free++; + else if (v == bad_cluster_value) bad++; + } + used = nb_clusters - free - bad; + EXTEND(SP, 3); + PUSHs(sv_2mortal(newSViv(free))); + PUSHs(sv_2mortal(newSViv(bad))); + PUSHs(sv_2mortal(newSViv(used))); + +unsigned int +next(unused, cluster) + void *unused + unsigned int cluster + CODE: + RETVAL = next(cluster); + OUTPUT: + RETVAL + +int +checkFat(fat_flag_map_, cluster, type, name) + char *fat_flag_map_ + unsigned int cluster + int type + char *name + CODE: + int nb = 0; + fat_flag_map = fat_flag_map_; + + for (; cluster < bad_cluster_value; cluster = next(cluster)) { + if (cluster == 0) croak("Bad FAT: unterminated chain for %s\n", name); + + if (fat_flag_map[cluster]) croak("Bad FAT: cluster $cluster is cross-linked for %s\n", name); + fat_flag_map[cluster] = type; + nb++; + } + RETVAL = nb; + OUTPUT: + RETVAL + +unsigned int +flag(cluster) + unsigned int cluster + CODE: + RETVAL = fat_flag_map[cluster]; + OUTPUT: + RETVAL + +void +set_flag(cluster, flag) + unsigned int cluster + int flag + CODE: + fat_flag_map[cluster] = flag; + diff --git a/perl-install/resize_fat/dir_entry.pm b/perl-install/resize_fat/dir_entry.pm index cfee23dae..0739b0951 100644 --- a/perl-install/resize_fat/dir_entry.pm +++ b/perl-install/resize_fat/dir_entry.pm @@ -21,14 +21,9 @@ sub set_cluster($$) { $entry->{first_cluster_high} = $val >> 16 if $resize_fat::isFAT32; } -sub is_directory_raw($) { - my ($entry) = @_; - !is_special_entry($entry) && $entry->{attributes} & $DIRECTORY_ATTR; -} - sub is_directory($) { my ($entry) = @_; - is_directory_raw($entry) && $entry->{name} !~ /^\.\.? /; + $entry->{attributes} & $DIRECTORY_ATTR && $entry->{name} !~ /^\.\.? / && !is_special_entry($entry); } sub is_volume($) { diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm index 46e810021..f62203e50 100644 --- a/perl-install/resize_fat/directory.pm +++ b/perl-install/resize_fat/directory.pm @@ -24,10 +24,11 @@ my @fields = ( 'first_cluster', 'length', ); +my $psizeof_format = psizeof($format); 1; -sub entry_size { psizeof($format) } +sub entry_size { $psizeof_format } #- call `f' for each entry of the directory #- if f return true, then modification in the entry are taken back @@ -35,7 +36,7 @@ sub traverse($$$) { my ($fs, $directory, $f) = @_; for (my $i = 0;; $i++) { - my $raw = \substr($directory, $i * psizeof($format), psizeof($format)); + my $raw = \substr($directory, $i * $psizeof_format, $psizeof_format); #- empty entry means end of directory $$raw =~ /^\0*$/ and return $directory; diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm index e6039077a..67c64165c 100644 --- a/perl-install/resize_fat/fat.pm +++ b/perl-install/resize_fat/fat.pm @@ -5,6 +5,7 @@ use strict; use resize_fat::any; use resize_fat::io; +use resize_fat::c_rewritten; 1; @@ -20,15 +21,8 @@ sub read($) { $fs->{fat} = $fs->{fats}[0]; - my ($free, $bad, $used) = (0, 0, 0); - - for (my $i = 2; $i < $fs->{nb_clusters} + 2; $i++) { - my $cluster = &next($fs, $i); - if ($cluster == 0) { $free++; } - elsif ($cluster == $resize_fat::bad_cluster_value) { $bad++; } - else { $used++; } - } - @{$fs->{clusters}{count}}{qw(free bad used)} = ($free, $bad, $used); + @{$fs->{clusters}{count}}{qw(free bad used)} = + resize_fat::c_rewritten::scan_fat($fs->{fat}, $fs->{nb_clusters}, $fs->{fs_type_size}); } sub write($) { @@ -61,7 +55,7 @@ sub allocate_remap { $fs->{last_free_cluster} = 2; for ($cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) { if ($cluster < $cut_point) { - if ($fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY) { + if (resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::DIRECTORY) { &$get_new(); } else { $new_cluster = $cluster; @@ -80,7 +74,7 @@ sub update { my ($fs) = @_; for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) { - if ($fs->{fat_flag_map}[$cluster]) { + if (resize_fat::c_rewritten::flag($cluster)) { my $old_next = &next($fs, $cluster); my $new = $fs->{fat_remap}[$cluster]; my $new_next = $fs->{fat_remap}[$old_next]; @@ -100,6 +94,7 @@ sub update { #- are done in count.c sub check($) { my ($fs) = @_; + return; foreach (@{$fs->{fats}}) { $_ eq $fs->{fats}[0] or die "FAT tables do not match"; } @@ -118,12 +113,13 @@ sub endianness($$) { $r; } -sub next($$) { - my ($fs, $cluster) = @_; - $cluster > $fs->{nb_clusters} + 2 and die "fat::next: cluster $cluster outside filesystem"; - endianness(vec($fs->{fat}, $cluster, $fs->{fs_type_size}), $fs->{fs_type_size}); +#-sub next($$) { +#- my ($fs, $cluster) = @_; +#- $cluster > $fs->{nb_clusters} + 2 and die "fat::next: cluster $cluster outside filesystem"; +#- endianness(vec($fs->{fat}, $cluster, $fs->{fs_type_size}), $fs->{fs_type_size}); +#-} +*next = \&resize_fat::c_rewritten::next; -} sub set_next($$$) { my ($fs, $cluster, $new_v) = @_; $cluster > $fs->{nb_clusters} + 2 and die "fat::set_next: cluster $cluster outside filesystem"; diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm index 1e5ac62be..762d18bca 100644 --- a/perl-install/resize_fat/main.pm +++ b/perl-install/resize_fat/main.pm @@ -64,7 +64,7 @@ sub copy_clusters { } }; for (; $cluster < $fs->{nb_clusters} + 2; $cluster++) { - $fs->{fat_flag_map}[$cluster] == $resize_fat::any::FILE or next; + resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::FILE or next; push @buffer, $fs->{fat_remap}[$cluster], resize_fat::io::read_cluster($fs, $cluster); @buffer > 50 and &$flush(); } @@ -78,11 +78,11 @@ sub construct_dir_tree { if ($resize_fat::isFAT32) { #- fat32's root must remain in the first 64k clusters #- so don't set it as DIRECTORY, it will be specially handled - $fs->{fat_flag_map}[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE; + resize_fat::c_rewritten::set_flag($fs->{fat32_root_dir_cluster}, $resize_fat::any::FREE); } for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) { - $fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY or next; + resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::DIRECTORY or next; resize_fat::io::write_cluster($fs, $fs->{fat_remap}[$cluster], -- cgit v1.2.1