summaryrefslogtreecommitdiffstats
path: root/perl-install/interactive.pm
Commit message (Expand)AuthorAgeFilesLines
* better english (writing style rather than spoken one)Thierry Vignaud2004-12-131-1/+1
* fix prototypePascal Rigaux2004-11-181-1/+1
* remove some unneeded ";", add some for normalization (as told by perl_checker)Pascal Rigaux2004-11-181-1/+1
* no need for thisPascal Rigaux2004-02-131-1/+1
* (vnew) do not complaint about being run as root when --testing was passedThierry Vignaud2004-02-131-1/+1
* ->ask_from_entry and ->ask_from_entries are better with focus_firstPascal Rigaux2004-02-041-3/+3
* remove arrows from previous/next buttons according to interface teamThierry Vignaud2004-01-161-2/+2
* - install_steps_auto_install is not a interactive but still needs do_pkgsPascal Rigaux2004-01-121-6/+3
* new do_pkgs package which get rid of pkgs_interactive::* which was in install...Pascal Rigaux2004-01-091-0/+6
* fix ask_okcancel due to stock items changesThierry Vignaud2003-07-151-1/+1
* let interactive uses stock items on x11 and old drak translated items inThierry Vignaud2003-07-141-2/+2
* - methods with no argument are not functions with no argument!Pascal Rigaux2003-05-261-5/+5
* have the "Ok" in ask_from__add_modify_remove return true in default mode (eg:...Pascal Rigaux2003-05-121-1/+1
* perl_checker compliancePascal Rigaux2003-04-301-1/+1
* perl_checker adaptations + fixesPascal Rigaux2003-04-241-7/+7
* perl_checker compliance for optional method argumentsPascal Rigaux2003-04-221-26/+28
* adapt to new help.pmPascal Rigaux2003-04-221-3/+3
* new perl_checker compliancePascal Rigaux2003-04-171-10/+10
* oops i didn't understand the internals of wait_message hence breaking it. hop...Guillaume Cottenceau2003-02-201-2/+2
* Gtk2::Label::set is deprecatedGuillaume Cottenceau2003-02-201-2/+2
* have less warnings when debuggingPascal Rigaux2003-02-201-2/+2
* - factorize "Help"-button handlingPascal Rigaux2003-02-161-4/+20
* in ask_browse_tree_info, have Next instead of Ok, Previous instead of Cancel ...Pascal Rigaux2003-02-141-1/+2
* fix ask_warn(), really dont make it popPascal Rigaux2003-02-131-2/+2
* don't force pop_it on ask_warn'sPascal Rigaux2003-02-131-1/+0
* - set_help is deprecatedPascal Rigaux2003-02-131-0/+9
* add ask_yesorno_, ask_okcancel_, ask_warn_, ask_from_listf_raw (to allow help)Pascal Rigaux2003-02-131-27/+41
* allow {interactive_help} per dialog boxes instead of globalPascal Rigaux2003-02-121-1/+2
* perl_checker compliance ("ref" now need parentheses in many case)Pascal Rigaux2003-02-121-2/+2
* add option advanced_state: if set to 1, force the "Advanced" part of the dial...Guillaume Cottenceau2003-02-081-0/+1
* add possibility to display images in tree-lists and bool-listsGuillaume Cottenceau2003-02-081-2/+3
* (helper_separator_tree_to_tree): this new function helps transforming aPascal Rigaux2003-01-301-0/+26
* cleaning the utf8 support stuff:Thierry Vignaud2003-01-281-3/+1
* strip authentification out of interactive->vnew into common.pmThierry Vignaud2003-01-271-14/+1
* (ask_from_list, ask_from_list_, ...): option nocancel addedPascal Rigaux2003-01-241-11/+15
* fix non latin1 post-install perl-gtk2 apps, seems like perl upgrading strings...Guillaume Cottenceau2003-01-241-0/+2
* add some documentation about the various possible fieldsPascal Rigaux2003-01-221-1/+13
* when the return value of ask_from_ and ask_from is not used, do not have aPascal Rigaux2003-01-211-0/+2
* fix ask_okcancel in wizard modePascal Rigaux2003-01-071-1/+1
* use "if any" instead of "if grep", and various other occurences of "any", "ev...Pascal Rigaux2003-01-071-3/+3
* nicer debug messagePascal Rigaux2003-01-071-0/+1
* - callbacks "Add", "Modify" and "Remove" return undef when they failPascal Rigaux2003-01-051-3/+7
* fix call to method ask_from__add_modify_removeWPascal Rigaux2003-01-031-1/+1
* (ask_from__add_modify_remove): check all callbacks are givenPascal Rigaux2003-01-021-0/+2
* (ask_from__add_modify_remove): fixPascal Rigaux2003-01-021-7/+4
* add ask_from__add_modify_remove, and use it for bootloader entriesPascal Rigaux2003-01-021-0/+26
* remove unused variables or rename them with an underscore (eg: $o becomes $_o)Pascal Rigaux2002-12-041-6/+6
* "require log" causes some pb, perl thinking that "log" is the log() function....Pascal Rigaux2002-12-041-2/+2
* perl_checker adaptationsPascal Rigaux2002-11-271-3/+3
* no need to call common::backtrace(), use directly backtrace() (was it written...Pascal Rigaux2002-11-261-2/+2
xa0, "\x25\x03\x4E\x02\xCD\x13" ], [ 'dos', 0xa0, "\x00\xB4\x08\xCD\x13\x72" ], #- nt2k's [ 'dos', 0x60, "\xBB\x00\x7C\xB8\x01\x02\x57\xCD\x13\x5F\x73\x0C\x33\xC0\xCD\x13" ], #- nt's [ 'dos', 0x70, "\x0C\x33\xC0\xCD\x13\x4F\x75\xED\xBE\xA3" ], [ 'freebsd', 0xC0, "\x00\x30\xE4\xCD\x16\xCD\x19\xBB\x07\x00\xB4" ], [ 'freebsd', 0x160, "\x6A\x10\x89\xE6\x48\x80\xCC\x40\xCD\x13" ], [ 'dummy', 0xAC, "\x0E\xB3\x07\x56\xCD\x10\x5E\xEB" ], #- caldera? [ 'ranish', 0x100, "\x6A\x10\xB4\x42\x8B\xF4\xCD\x13\x8B\xE5\x73" ], [ 'os2', 0x1c2, "\x0A" ], [ 'Acronis', 0, "\xE8\x12\x01" ], ); sub typeOfMBR($) { typeFromMagic(devices::make($_[0]), @MBR_signatures) } sub typeOfMBR_($) { typeFromMagic($_[0], @MBR_signatures) } sub use_pt_type { 0 } sub hasExtended { 0 } sub set_best_geometry_for_the_partition_table {} sub cylinder_size($) { my ($hd) = @_; $hd->{geom}{sectors} * $hd->{geom}{heads}; } sub first_usable_sector { 1 } sub last_usable_sector { my ($hd) = @_; $hd->{totalsectors}; } # no limit sub max_partition_start { 1e99 } sub max_partition_size { 1e99 } #- default method for starting a partition sub adjustStart($$) {} #- adjusting end to match a cylinder boundary, two methods are used and must #- match at the end, else something is wrong and nothing will be done on #- partition table. #- $end2 is computed by removing 2 (or only 1 if only 2 heads on drive) groups #- of sectors, this is necessary to handle extended partition where logical #- partition start after 1 (or 2 accepted) groups of sectors (typically 63). #- $end is floating (is not on cylinder boudary) so we have to choice a good #- candidate, $end1 or $end2 should always be good except $end1 for small #- partition size. sub adjustEnd($$) { my ($hd, $part) = @_; my $end = $part->{start} + $part->{size}; $end > $hd->{geom}{cylinders} * cylinder_size($hd) && $end <= $hd->{totalsectors} and return; my $end1 = round_down($end, cylinder_size($hd)); my $end2 = round_up($end - ($hd->{geom}{heads} > 2 ? 2 : 1) * $hd->{geom}{sectors}, cylinder_size($hd)); $end2 <= $hd->{geom}{cylinders} * cylinder_size($hd) or die "adjustEnd go beyond end of device geometry ($end2 > $hd->{totalsectors})"; $part->{size} = ($end1 - $part->{start} > cylinder_size($hd) ? $end1 : $end2) - $part->{start}; $part->{size} > 0 or internal_error("adjustEnd get a too small partition to handle correctly"); } sub compute_nb_cylinders { my ($geom, $totalsectors) = @_; if ($geom->{heads} && $geom->{sectors}) { $geom->{cylinders} = int $totalsectors / $geom->{heads} / $geom->{sectors}; } } sub keep_non_duplicates { my %l; $l{$_->[0]}++ foreach @_; map { @$_ } grep { $l{$_->[0]} == 1 } @_; } sub get_geometries { my (@hds) = @_; @hds = grep { if ($_->{bus} =~ /dmraid/) { sysopen(my $F, $_->{file}, 0); my $total = c::total_sectors(fileno $F); my %geom; $geom{heads} = 255; $geom{sectors} = 63; $geom{start} = 1; compute_nb_cylinders(\%geom, $total); $geom{totalcylinders} = $geom{cylinders}; log::l("Fake geometry on " . $_->{file} . ": heads=$geom{heads} sectors=$geom{sectors} cylinders=$geom{cylinders} start=$geom{start}"); add2hash_($_, { totalsectors => $total, geom => \%geom }); 1; } elsif (my $h = get_geometry($_->{file})) { add2hash_($_, $h); 1; } else { log::l("An error occurred while getting the geometry of block device $_->{file}: $!"); 0; } } @hds; my %id2hd = keep_non_duplicates(map { my $F = openit($_) or log::l("failed to open device $_->{device}"); my $tmp; if ($F && c::lseek_sector(fileno($F), 0, 0x1b8) && sysread($F, $tmp, 4)) { [ sprintf('0x%08x', unpack('V', $tmp)), $_ ]; } else { (); } } @hds); my %id2edd = keep_non_duplicates(map { [ scalar(chomp_(cat_("$_/mbr_signature"))), $_ ] } glob("/sys/firmware/edd/int13_dev*")); log::l("id2hd: " . join(' ', map_each { "$::a=>$::b->{device}" } %id2hd)); log::l("id2edd: " . join(' ', map_each { "$::a=>$::b" } %id2edd)); foreach my $id (keys %id2hd) { my $hd = $id2hd{$id}; $hd->{volume_id} = $id; if (my $edd_dir = $id2edd{$id}) { $hd->{bios_from_edd} = $1 if $edd_dir =~ /int13_dev(.*)/; require partition_table::dos; my $geom = partition_table::dos::geometry_from_edd($hd, $edd_dir); $hd->{geom} = $geom if $geom; } } @hds; } sub get_geometry { my ($dev) = @_; sysopen(my $F, $dev, 0) or return; my $total = c::total_sectors(fileno $F); my $g = ""; my %geom; if (ioctl($F, c::HDIO_GETGEO(), $g)) { @geom{qw(heads sectors cylinders start)} = unpack "CCSL", $g; log::l("HDIO_GETGEO on $dev succeeded: heads=$geom{heads} sectors=$geom{sectors} cylinders=$geom{cylinders} start=$geom{start}"); $geom{totalcylinders} = $geom{cylinders}; #- $geom{cylinders} is no good (only a ushort, that means less than 2^16 => at best 512MB) if ($total) { compute_nb_cylinders(\%geom, $total); } else { $total = $geom{heads} * $geom{sectors} * $geom{cylinders}; } } { totalsectors => $total, if_($geom{heads}, geom => \%geom) }; } sub openit { my ($hd, $o_mode) = @_; my $F; sysopen($F, $hd->{file}, $o_mode || 0) && $F; } sub can_add { my ($hd) = @_; !$_->{size} && !$_->{pt_type} || isExtended($_) and return 1 foreach @{$hd->{primary}{raw}}; 0; } sub raw_removed { my ($_hd, $_raw) = @_; } sub can_raw_add { my ($hd) = @_; $_->{size} || $_->{pt_type} or return 1 foreach @{$hd->{primary}{raw}}; 0; } sub raw_add { my ($_hd, $raw, $part) = @_; foreach (@$raw) { $_->{size} || $_->{pt_type} and next; $_ = $part; return; } die "raw_add: partition table already full"; } sub zero_MBR { &partition_table::initialize } #- deprecated sub clear_existing { my ($hd) = @_; my @parts = (partition_table::get_normal_parts($hd), if_($hd->{primary}{extended}, $hd->{primary}{extended})); partition_table::will_tell_kernel($hd, del => $_) foreach @parts; } #- deprecated sub zero_MBR_and_dirty { my ($hd) = @_; fsedit::partition_table_clear_and_initialize([], $hd); } sub read_primary { my ($hd) = @_; my ($pt, $info) = eval { $hd->read_one(0) } or return; my $primary = partition_table::raw::pt_info_to_primary($hd, $pt, $info); $hd->{primary} = $primary; undef $hd->{extended}; partition_table::verifyPrimary($primary); 1; } sub pt_info_to_primary { my ($hd, $pt, $info) = @_; my @extended = $hd->hasExtended ? grep { isExtended($_) } @$pt : (); my @normal = grep { $_->{size} && !isEmpty($_) && !isExtended($_) } @$pt; my $nb_special_empty = int(grep { $_->{size} && isEmpty($_) } @$pt); @extended > 1 and die "more than one extended partition"; put_in_hash($_, partition_table::hd2minimal_part($hd)) foreach @normal, @extended; { raw => $pt, extended => $extended[0], normal => \@normal, info => $info, nb_special_empty => $nb_special_empty }; } #- ugly stuff needed mainly for Western Digital IDE drives #- try writing what we've just read, yells if it fails #- testing on last sector of head #0 (unused in 99% cases) #- #- return false if the device cannot be written to (especially for Smartmedia) sub test_for_bad_drives { my ($hd) = @_; my $sector = $hd->{geom} ? $hd->{geom}{sectors} - 1 : 0; log::l("test_for_bad_drives($hd->{file} on sector #$sector)"); sub error { die "$_[0] error: $_[1]" } my $F = openit($hd, $::testing ? 0 : 2) or error(openit($hd) ? 'write' : 'read', "cannot open device"); my $seek = sub { c::lseek_sector(fileno($F), $sector, 0) or error('read', "seeking to sector $sector failed"); }; my $tmp; &$seek; sysread $F, $tmp, $SECTORSIZE or error('read', "cannot even read ($!)"); return if $hd->{readonly} || $::testing; &$seek; syswrite $F, $tmp or error('write', "cannot even write ($!)"); my $tmp2; &$seek; sysread $F, $tmp2, $SECTORSIZE or die "test_for_bad_drives: cannot even read again ($!)"; $tmp eq $tmp2 or die N("Something bad is happening on your hard disk drive. A test to check the integrity of data has failed. It means writing anything on the disk will end up with random, corrupted data."); } 1;