#!/usr/bin/perl # DrakFloppy # $Id: drakfloppy,v 1.41 2003/07/14 19:22:17 tvignaud Exp $ # # Copyright (C) 2001-2003 MandrakeSoft # Yves Duret # Thierry Vignaud # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # 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. use strict; use diagnostics; use lib qw(/usr/lib/libDrakX); use standalone; #- warning, standalone must be loaded very first, for 'explanations' use common; use ugtk2 qw(:create :dialogs :helpers :wrappers); use detect_devices; #- languages that can't be displayed with gtk1, so we unset translations #- for them until this tool is ported to gtk2 $ENV{LANGUAGE} = "C" if $ENV{LANGUAGE} =~ /\b(ar|he|hi|ta)/; require_root_capability(); my $expert_mode = $::expert; my $window = ugtk2->new('drakfloppy'); unless ($::isEmbedded) { $window->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) }); $window->{rwindow}->set_title(N("drakfloppy")); $window->{rwindow}->set_border_width(5); ### menus definition # the menus are not shown but they provides shiny shortcut like C-q create_factory_menu($window->{rwindow}, ( { path => N("/_File"), item_type => '' }, { path => N("/File/_Quit"), accelerator => N("Q"), callback => sub { ugtk2->exit(0) } }, ) ); } my ($output, @modules, @temp_modules, %buttons, %options, $tree_model, $tree, $list_model, $list); ######## up part # device part my $device_combo = new Gtk2::Combo(); $device_combo->entry->set_editable(0); $device_combo->set_popdown_strings(map { "/dev/" . $_->{device} } detect_devices::floppies()); # kernel part my $kernel_combo = new Gtk2::Combo(); $kernel_combo->disable_activate; $kernel_combo->set_popdown_strings(sort grep { !/^\.\.?$/ } all("/lib/modules")); $kernel_combo->entry->set_text(chomp_(`uname -r`)); ########################################################## my $tips = new Gtk2::Tooltips; ### main window $window->{window}->add( gtkpack_(Gtk2::VBox->new, if_($::isEmbedded, 0, new Gtk2::Label(N("boot disk creation"))), 0, gtkadd(Gtk2::Frame->new(N("General")), gtkpack__(new Gtk2::VBox(0, 0), gtkpack__(new Gtk2::HBox(1, 0), Gtk2::Label->new(N("device")), $device_combo, gtksignal_connect(Gtk2::Button->new(N("default")), clicked => sub { $device_combo->entry->set_text("/dev/fd0") }), ), gtkpack__(new Gtk2::HBox(1, 0), Gtk2::Label->new(N("kernel version")), $kernel_combo, gtksignal_connect(Gtk2::Button->new("default"), clicked => sub { $kernel_combo->entry->set_text(chomp_(`uname -r`)); }), ), ), ), 0, gtksignal_connect(gtkset_active(Gtk2::CheckButton->new(N("Expert Mode")), $expert_mode), clicked => \&toggle_expert_button), 1, gtkadd(my $expert_mod_frame = Gtk2::Frame->new(N("Output")), gtkpack_(gtkset_size_request( gtkset_border_width( Gtk2::HBox->new(0, 0), 5), 30, 75), 1, $output = gtkset_editable(Gtk2::TextView->new, 0), ), ), 0, gtkpack__(new Gtk2::HButtonBox(), gtksignal_connect(Gtk2::Button->new_from_stock('gtk-cancel'), clicked => sub { ugtk2->exit(0) } ), gtksignal_connect(Gtk2::Button->new_from_stock('gtk-preferences'), clicked => \&pref_dialog), gtksignal_connect(gtkset_tip($tips, Gtk2::Button->new_from_stock('gtk-ok'), N("Build the disk")), clicked => \&build_it ), ), ), ); $window->{rwindow}->show_all; $expert_mod_frame->set_sensitive($expert_mode); $window->main; ugtk2->exit(0); sub toggle_expert_button() { my ($expert_button) = @_; $expert_mode = $expert_button->get_active; $expert_mod_frame->set_sensitive($expert_mode); } sub pref_dialog() { my $dialog = gtkset_modal(gtkset_size_request(_create_dialog(N("Advanced preferences")), 600, -1), 1); $dialog->set_transient_for($window->{rwindow}) unless $::isEmbedded; # Create root tree: $tree_model = Gtk2::TreeStore->new(("Glib::String") x 2, "Glib::Int"); $tree = Gtk2::TreeView->new_with_model($tree_model); $tree->set_headers_visible(0); $tree->append_column(my $textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); $tree->signal_connect('row-expanded', \&expand_tree); $tree->get_selection->signal_connect('changed' => \&selected_tree); # Create modules list: $list_model = Gtk2::ListStore->new(("Glib::String") x 3); # relative path, size, (hidden full path) $list = Gtk2::TreeView->new_with_model($list_model); each_index { $list->append_column(my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i)); $col->set_sort_column_id($::i); $col->set_min_width((200, 50)[$::i]); } (N("Module name"), N("Size")); gtkpack_($dialog->vbox, 0, gtkadd(Gtk2::Frame->new(N("mkinitrd optional arguments")), gtkpack__(Gtk2::VBox->new(0, 5), $buttons{force} = new Gtk2::CheckButton(N("force")), $buttons{raid} = new Gtk2::CheckButton(N("omit raid modules")), $buttons{needed} = new Gtk2::CheckButton(N("if needed")), $buttons{scsi} = new Gtk2::CheckButton(N("omit scsi modules")), ), ), 1, gtkadd(Gtk2::Frame->new(N("Add a module")), create_hpaned( gtkset_size_request( create_scrolled_window($tree), 200, $::isEmbedded ? 0 : 175), gtkpack_(Gtk2::VBox->new(0, 0), 1, gtkadd(Gtk2::ScrolledWindow->new, $list ), 0, gtksignal_connect(Gtk2::Button->new(N("Remove a module")), clicked => sub { my $iter = ($list->get_selection->get_selected)[1]; return unless $iter; my $removed = $list_model->get($iter, 2); $list_model->remove($iter); @temp_modules = grep { $_ ne $removed } @temp_modules; }), ), ), ), ); # restore values: $buttons{$_}->set_active($options{$_}) foreach keys %buttons; fill_tree($kernel_combo->entry->get_text); $list_model->append_set([ map_index { $::i => $_ } @$_ ]) foreach @modules; @temp_modules = (); gtkpack($dialog->action_area, gtksignal_connect(Gtk2::Button->new_from_stock('gtk-cancel'), clicked => sub { $dialog->destroy }), gtksignal_connect(Gtk2::Button->new_from_stock('gtk-ok'), clicked => sub { # save values: $options{$_} = $buttons{$_}->get_active foreach keys %buttons; my $val; @modules = (); $list_model->foreach(sub { my ($model, $_path, $iter) = @_; push @modules, [ $model->get($iter, 0), $model->get($iter, 1), $model->get($iter, 2) ]; return 0; }, $val); $dialog->destroy; }), ); $dialog->show_all; $dialog->run; } #------------------------------------------------------------- # tree functions #------------------------------------------------------------- ### Subroutines sub fill_tree { my ($root_dir) = @_; $root_dir = "/lib/modules/" . $root_dir; # Create root tree item widget my $parent_iter = $tree_model->append_set(undef, [ 0 => $root_dir, 1 => $root_dir, 2 => has_sub_trees($root_dir) ]); # Create the subtree expand_tree($tree, $parent_iter, $tree_model->get_path($parent_iter)) if has_sub_trees($root_dir); } # Called whenever an item is clicked on the tree widget. sub selected_tree { my ($select) = @_; my ($model, $iter) = $select->get_selected; return unless $model; # no real selection my $file = $model->get($iter, 1); return if -d $file; my $size = (lstat($file))[7]; return if member($file, @temp_modules); push @temp_modules, $file; $list_model->append_set([ 0 => stripit($file), 1 => $size, 2 => $file ]); } # Callback for expanding a tree - find subdirectories, files and add them to tree sub expand_tree { my ($tree, $parent_iter, $path) = @_; return if !$tree || !$parent_iter; my $dir = $tree_model->get($parent_iter, 1); #- if we're hinted to be expandable if ($tree_model->get($parent_iter, 2)) { #- hackish: if first child has '' as name, then we need to expand on the fly if ($tree_model->iter_has_child($parent_iter)) { my $child = $tree_model->iter_children($parent_iter); # BUG: ->iter_children return invalid iterators !!! thus the dummy empty line $tree_model->remove($child); #if $tree_model->iter_is_valid($child) && $tree_model->get($child, 0) eq ''; } # do not refill the parent anymore $tree_model->set($parent_iter, 2 => 0); foreach my $dir_entry (all($dir)) { my $entry_path = $dir . "/" . $dir_entry; if (-d $entry_path || $dir_entry =~ /\.(k|)o(\.gz)?$/) { $entry_path =~ s|//|/|g; my $iter = $tree_model->append_set($parent_iter, [ 0 => $dir_entry, 1 => $entry_path, 2 => has_sub_trees($entry_path) ]); #- hackery for partial displaying of trees, used in rpmdrake: #- if leaf is void, we may create the parent and one child (to have the [+] in front of the parent in the ctree) #- though we use '' as the label of the child; then rpmdrake will connect on tree_expand, and whenever #- the first child has '' as the label, it will remove the child and add all the "right" children $tree_model->append_set($iter, [ 0 => '' ]) if has_sub_trees($entry_path); } } } $tree->expand_row($path, 0); } #------------------------------------------------------------- # the function #------------------------------------------------------------- sub build_it() { my $co = "/sbin/mkbootdisk --noprompt --verbose --device " . $device_combo->entry->get_text; $co .= " --mkinitrdargs -f" if $options{force}; $co .= " --mkinitrdargs --ifneeded" if $options{needed}; $co .= " --mkinitrdargs --omit-scsi-modules" if $options{scsi}; $co .= " --mkinitrdargs --omit-raid-modules" if $options{raid}; $co .= join(" --mkinitrdargs --with=", map { $_->[0] } @modules); $co .= " " . $kernel_combo->entry->get_text; $co .= " 2>&1 |"; warn_dialog(N("Warning"), N("Be sure a media is present for the device %s", $device_combo->entry->get_text)) or return; # we test if the media is present test: my $a = "dd count=1 if=/dev/null of=" . $device_combo->entry->get_text . " 2>&1"; my $b = `$a`; if ($b =~ /dd/) { err_dialog(N("Error"), N("There is no medium or it is write-protected for device %s.\nPlease insert one.", $device_combo->entry->get_text), { cancel => 1 }) ? goto test : return 0; } local *STATUS; open STATUS, $co or do { err_dialog(N("Error"), N("Unable to fork: %s", $!)); return }; local $_; while () { gtktext_append($output, [ [ $_ ] ]); } close STATUS or err_dialog(N("Error"), N("Unable to properly close mkbootdisk: \n %s \n %s", $!, $?)); return (0); } #### # This is put at the end of the file because any translatable string # appearing after this will not be found by xgettext, and so wont end in # the pot file... #### # Test whether a directory has subdirectories sub has_sub_trees { my ($dir) = @_; foreach my $file (glob_("$dir/*")) { return 1 if -d $file || $file =~ /\.(k|)o(\.gz)?$/; } return 0; } sub stripit { my ($file) = @_; $file =~ s|/lib/modules/.*?/||g; $file; }