← Back to branch summary

~ubuntu-branches/ubuntu/maverick/apt/maverick-security

« back to all changes in this revision

Viewing changes to dselect/setup

  • Committer: Bazaar Package Importer
  • Author(s): Jason Gunthorpe
  • Date: 2001-08-18 17:21:59 UTC
  • Revision ID: james.westby@ubuntu.com-20010818172159-85f7g43wdzi9dwb5
Tags: 0.5.4
http://bugs.debian.org/88913
http://bugs.debian.org/89121
http://bugs.debian.org/89854
http://bugs.debian.org/99671
http://bugs.debian.org/98353
http://bugs.debian.org/95823
http://bugs.debian.org/93057
http://bugs.debian.org/89066
http://bugs.debian.org/89066
http://bugs.debian.org/89152
http://bugs.debian.org/56708
http://bugs.debian.org/59432
http://bugs.debian.org/89671
http://bugs.debian.org/92033
http://bugs.debian.org/93652
http://bugs.debian.org/98468
http://bugs.debian.org/103020
http://bugs.debian.org/97809
http://bugs.debian.org/102951
http://bugs.debian.org/99974
http://bugs.debian.org/107362
http://bugs.debian.org/107395
http://bugs.debian.org/107362
http://bugs.debian.org/92757
http://bugs.debian.org/90027
http://bugs.debian.org/94286
http://bugs.debian.org/89762
http://bugs.debian.org/92025
http://bugs.debian.org/86954
http://bugs.debian.org/94618
http://bugs.debian.org/65691
http://bugs.debian.org/100046
http://bugs.debian.org/97520
http://bugs.debian.org/100325
http://bugs.debian.org/102293
http://bugs.debian.org/100590
http://bugs.debian.org/98928
http://bugs.debian.org/98695
http://bugs.debian.org/106591
http://bugs.debian.org/97364
* M68k config.guess patch. Closes: #88913
* Bi-yearly test on OpenBSD and Solaris
* Doc updates. Closes: #89121, #89854, #99671, #98353, #95823, #93057,
        #97520, #102867, #101071, #102421, #101565, #98272, #106914,
        #105606, #105377
* Various cosmetic code updates. Closes: #89066, #89066, #89152
* Add "pre-auto" as an option for DSelect::Clean (run autoclean after
  update).
* More patches from Alfredo for Vendors and more SHA-1 stuff
* Fix for AJ's 'desire to remove perl-5.005' and possibly other
  similar situations. Closes: #56708, #59432
* no_proxy and ftp. Closes: #89671
* Philippe Batailler's man page patches.
* Fix for display bug. Closes: #92033, #93652, #98468
* Use more than 16bits for the dep ID. Some people ran out..
  Closes: #103020, #97809, #102951, #99974, #107362, #107395, #107362,
          #106911, #107395, #108968
* Reordered some things to make dante and FTP happier. Closes: #92757
* James R. Van Zandt's guide.sgml updates. Closes: #90027
* apt-ftparchive copes with no uncompressed package files + contents.
* French man pages from philippe batailler - well sort of. They 
  don't build yet..
* run-parts. Closes: #94286
* 'apt-cache policy' preferences debug tool.
* Whatever. Closes: #89762
* libstdc++ and HURD. Closes: #92025
* More apt-utils verbage. Closes: #86954
* Fliped comparision operator. Closes: #94618
* Used the right copyright file. Closes: #65691
* Randolph's G++3 patches. 
* Fixed no_proxy tokanizing. Closes: #100046
* Strip Config-Version when copying status to available. Closes: #97520
* Segfault with missing source files. Closes: #100325
* EINTR check. Closes: #102293
* Various changes to the locking metholodgy for --print-uris. 
  Closes: #100590
* Lame LD_LIBRARY_PATH thing. Closes: #98928
* apt-cache search searchs provide names too now. Closes: #98695
* Checksum and long lines problem. Closes: #106591
* .aptignr and empty files are just a warning. Closes: #97364  

Show diffs side-by-side

added added

removed removed

Lines of Context:
dselect/setup
 
1
#!/usr/bin/perl -w
 
2
#                              -*- Mode: Perl -*- 
 
3
# setup.pl --- 
 
4
# Author           : Manoj Srivastava ( srivasta@tiamat.datasync.com ) 
 
5
# Created On       : Wed Mar  4 15:11:47 1998
 
6
# Created On Node  : tiamat.datasync.com
 
7
# Last Modified By : Manoj Srivastava
 
8
# Last Modified On : Tue May 19 11:25:32 1998
 
9
# Last Machine Used: tiamat.datasync.com
 
10
# Update Count     : 87
 
11
# Status           : Unknown, Use with caution!
 
12
# HISTORY          : 
 
13
# Description      : 
 
14
# This file is designed to go into /usr/lib/apt/methods/setup
 
15
# 
 
16
 
 
17
#use strict;
 
18
#use diagnostics;
 
19
#printf STDERR "DEBUG: Arguments $ARGV[0];$ARGV[1];$ARGV[2];\n";
 
20
 
 
21
 
 
22
# Handle the arguments
 
23
my $vardir=$ARGV[0];
 
24
my $method=$ARGV[1];
 
25
my $option=$ARGV[2];
 
26
my $config_file = '/etc/apt/sources.list';
 
27
 
 
28
my $boldon=`setterm -bold on`;
 
29
my $boldoff=`setterm -bold off`;
 
30
 
 
31
my @known_types           = ('deb');
 
32
my @known_access         = ('http', 'ftp', 'file');
 
33
my @typical_distributions = ('stable', 'unstable', 'frozen', 'non-US');
 
34
my @typical_components    = ('main', 'contrib', 'non-free');
 
35
 
 
36
my %known_access           = map {($_,$_)} @known_access;
 
37
my %typical_distributions  = map {($_,$_)} @typical_distributions;
 
38
 
 
39
# Read the config file, creating source records
 
40
sub read_config {
 
41
  my %params = @_;
 
42
  my @Config = ();
 
43
  
 
44
  die "Required parameter Filename Missing" unless
 
45
    $params{'Filename'};
 
46
  
 
47
  open (CONFIG, "$params{'Filename'}") ||
 
48
    die "Could not open $params{'Filename'}: $!";
 
49
  while (<CONFIG>) {
 
50
    chomp;
 
51
    my $rec = {};
 
52
    my ($type, $urn, $distribution, $components) = 
 
53
      m/^\s*(\S+)\s+(\S+)\s+(\S+)\s*(?:\s+(\S.*))?$/o;
 
54
    $rec->{'Type'}          = $type;
 
55
    $rec->{'URN'}           = $urn;
 
56
    $rec->{'Distribution'}  = $distribution;
 
57
    $rec->{'Components'}    = $components;
 
58
    push @Config, $rec;
 
59
  }
 
60
  close(CONFIG);
 
61
  
 
62
  return @Config;
 
63
}
 
64
 
 
65
# write the config file; writing out the current set of source records
 
66
sub write_config {
 
67
  my %params = @_;
 
68
  my $rec;
 
69
  my %Seen = ();
 
70
  
 
71
  die "Required parameter Filename Missing" unless
 
72
    $params{'Filename'};
 
73
  die "Required parameter Config Missing" unless
 
74
    $params{'Config'};
 
75
  
 
76
  open (CONFIG, ">$params{'Filename'}") ||
 
77
    die "Could not open $params{'Filename'} for writing: $!";
 
78
  for $rec (@{$params{'Config'}}) {
 
79
        my $line = "$rec->{'Type'} $rec->{'URN'} $rec->{'Distribution'} ";
 
80
    $line .= "$rec->{'Components'}" if $rec->{'Components'};
 
81
    $line .= "\n";
 
82
    print CONFIG $line unless $Seen{$line}++;
 
83
  }
 
84
  close(CONFIG);
 
85
}
 
86
 
 
87
# write the config file; writing out the current set of source records
 
88
sub print_config {
 
89
  my %params = @_;
 
90
  my $rec;
 
91
  my %Seen = ();
 
92
  
 
93
  die "Required parameter Config Missing" unless
 
94
    $params{'Config'};
 
95
  
 
96
  for $rec (@{$params{'Config'}}) {
 
97
    next unless $rec;
 
98
    
 
99
    my $line = "$rec->{'Type'} " if $rec->{'Type'};
 
100
    $line .= "$rec->{'URN'} " if $rec->{'URN'};
 
101
    $line .= "$rec->{'Distribution'} " if $rec->{'Distribution'};
 
102
    $line .= "$rec->{'Components'}" if $rec->{'Components'};
 
103
    $line .= "\n";
 
104
    print $line unless $Seen{$line}++;
 
105
  }
 
106
}
 
107
 
 
108
# Ask for and add a source record
 
109
sub get_source {
 
110
  my %params = @_;
 
111
  my $rec = {};
 
112
  my $answer;
 
113
  my ($type, $urn, $distribution, $components);
 
114
  
 
115
  if ($params{'Default'}) {
 
116
    ($type, $urn, $distribution, $components) = 
 
117
      $params{'Default'} =~ m/^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S.*)$/o;
 
118
  }
 
119
 
 
120
  $type         = 'deb';
 
121
  $urn          = "http://http.us.debian.org/debian" unless $urn;
 
122
  $distribution = "stable" unless $distribution;
 
123
  $components   = "main contrib non-free" unless $components;
 
124
 
 
125
    
 
126
  $rec->{'Type'} = 'deb';
 
127
  $| = 1;
 
128
 
 
129
  my $done = 0;
 
130
  
 
131
  while (!$done) {
 
132
    print "\n";
 
133
    print "$boldon URL [$urn]: $boldoff";
 
134
    
 
135
    $answer=<STDIN>;
 
136
    chomp ($answer);
 
137
    $answer =~ s/\s*//og;
 
138
    
 
139
    if ($answer =~ /^\s*$/o) {
 
140
      $rec->{'URN'} = $urn;
 
141
      last;
 
142
    }
 
143
    else {
 
144
      my ($scheme) = $answer =~ /^\s*([^:]+):/o;
 
145
      if (! defined $known_access{$scheme}) {
 
146
        print "Unknown access scheme $scheme in $answer\n";
 
147
        print "    The available access methods known to me are\n";
 
148
        print join (' ', @known_access), "\n";
 
149
        print "\n";
 
150
      }
 
151
      else {
 
152
        $rec->{'URN'} = $answer;
 
153
        last;
 
154
      }
 
155
    }
 
156
  }
 
157
 
 
158
  print "\n";
 
159
  
 
160
  print " Please give the distribution tag to get or a path to the\n";
 
161
  print " package file ending in a /. The distribution\n";
 
162
  print " tags are typically something like:$boldon ";
 
163
  print join(' ', @typical_distributions), "$boldoff\n";
 
164
  print "\n";
 
165
  print "$boldon Distribution [$distribution]:$boldoff ";
 
166
  $answer=<STDIN>;
 
167
  chomp ($answer);
 
168
  $answer =~ s/\s*//og;
 
169
  
 
170
  if ($answer =~ /^\s*$/o) {
 
171
    $rec->{'Distribution'} = $distribution;
 
172
    $rec->{'Components'}   = &get_components($components);
 
173
  }
 
174
  elsif ($answer =~ m|/$|o) {
 
175
    $rec->{'Distribution'} = "$answer";
 
176
    $rec->{'Components'}   = "";
 
177
  }
 
178
  else {
 
179
    # A distribution tag, eh?
 
180
    warn "$answer does not seem to be a typical distribution tag\n"
 
181
      unless defined $typical_distributions{$answer};
 
182
    
 
183
    $rec->{'Distribution'} = "$answer";
 
184
    $rec->{'Components'}   = &get_components($components);
 
185
  }
 
186
 
 
187
  return $rec;
 
188
}
 
189
 
 
190
sub get_components {
 
191
  my $default = shift;
 
192
  my $answer;
 
193
  
 
194
  print "\n";
 
195
  print " Please give the components to get\n";
 
196
  print " The components are typically something like:$boldon ";
 
197
  print join(' ', @typical_components), "$boldoff\n";
 
198
  print "\n";
 
199
  print "$boldon Components [$default]:$boldoff ";
 
200
  $answer=<STDIN>;
 
201
  chomp ($answer);
 
202
  $answer =~ s/\s+/ /og;
 
203
  
 
204
  if ($answer =~ /^\s*$/o) {
 
205
    return $default;
 
206
  }
 
207
  else {
 
208
    return $answer;
 
209
  }
 
210
}
 
211
 
 
212
sub get_sources {
 
213
  my @Config = ();
 
214
  my $done = 0;
 
215
 
 
216
  my @Oldconfig = ();
 
217
  
 
218
  if (-e $config_file) {
 
219
    @Oldconfig = &read_config('Filename' => $config_file)
 
220
  }
 
221
 
 
222
  print "\t$boldon Set up a list of distribution source locations $boldoff \n";
 
223
  print "\n";
 
224
 
 
225
  print " Please give the base URL of the debian distribution.\n";
 
226
  print " The access schemes I know about are:$boldon ";
 
227
  print join (' ', @known_access), "$boldoff\n";
 
228
#  print " The mirror scheme is special  that it does not specify the\n";
 
229
#  print " location of a debian archive but specifies the location\n";
 
230
#  print " of a list of mirrors to use to access the archive.\n";
 
231
  print "\n";
 
232
  print " For example:\n";
 
233
  print "              file:/mnt/debian,\n";
 
234
  print "              ftp://ftp.debian.org/debian,\n";
 
235
  print "              http://ftp.de.debian.org/debian,\n";
 
236
#  print " and the special mirror scheme,\n";
 
237
#  print "              mirror:http://www.debian.org/archivemirrors \n";
 
238
  print "\n";
 
239
 
 
240
  my $index = 0;
 
241
  while (!$done) {
 
242
    if ($Oldconfig[$index]) {
 
243
      push (@Config, &get_source('Default' => $Oldconfig[$index++]));
 
244
    }
 
245
    else {
 
246
      push (@Config, &get_source());
 
247
    }
 
248
    print "\n";
 
249
    print "$boldon Would you like to add another source?[y/N]$boldoff ";
 
250
    my $answer = <STDIN>;
 
251
    chomp ($answer);
 
252
    $answer =~ s/\s+/ /og;
 
253
    if ($answer =~ /^\s*$/o) {
 
254
      last;
 
255
    }
 
256
    elsif ($answer !~ m/\s*y/io) {
 
257
      last;
 
258
    } 
 
259
  }
 
260
  
 
261
  return @Config;
 
262
}
 
263
 
 
264
sub main {
 
265
  if (-e $config_file) {
 
266
    my @Oldconfig = &read_config('Filename' => $config_file);
 
267
    
 
268
    print "$boldon I see you already have a source list.$boldoff\n";
 
269
    print "-" x 72, "\n";
 
270
    &print_config('Config' => \@Oldconfig);
 
271
    print "-" x 72, "\n";
 
272
    print "$boldon Do you wish to change (overwrite) it?[y/N]$boldoff ";
 
273
    my $answer = <STDIN>;
 
274
    chomp ($answer);
 
275
    $answer =~ s/\s+/ /og;
 
276
    exit 0 unless $answer =~ m/\s*y/io;
 
277
  }
 
278
  # OK. They want to be here.
 
279
  my @Config = &get_sources();
 
280
  #&print_config('Config' => \@Config);
 
281
  &write_config('Config' => \@Config, 'Filename' => $config_file);  
 
282
}
 
283
 
 
284
&main();
 
285
 
 
286