2 # debbugs-loadsql is part of debbugs, and is released
3 # under the terms of the GPL version 2, or any later version, at your
4 # option. See the file README and COPYING for more information.
5 # Copyright 2012 by Don Armstrong <don@donarmstrong.com>.
11 use Getopt::Long qw(:config no_ignore_case);
16 debbugs-loadsql -- load debbugs sql database
20 debbugs-loadsql [options] [subcommand]
23 bugs help versions configuration
24 suites logs packages debinfo
26 --quick, -q only load changed things
27 --progress Show progress bar
28 --service, -s service name
29 --sysconfdir, -c postgresql service config dir
30 --spool-dir debbugs spool directory
31 --debug, -d debugging level (Default 0)
32 --help, -h display this help
33 --man, -m display manual
43 Add bugs (subject, number, etc) to the database
45 --preload create all bugs first, then add information
49 Add version descendant information (which version is based on which version) to
54 Add source maintainers to the BTS
58 Add debbugs configuration information (tags, severity, etc)
62 Add suite information from ftp distribution
64 --ftpdists location of FTP mirror
72 Add package information from the ftp archive
74 --ftpdists location of FTP mirror
75 --suites Suite to operate on
79 Add package information from a debinfo file
81 --null -0 names of debinfo files are null separated
89 Only load changed bugs
93 Show progress bar (requires Term::ProgressBar)
97 Postgreql service to use; defaults to debbugs
99 =item B<--sysconfdir,-c>
101 System configuration directory to use; if not set, defaults to the
102 postgresql default. [Operates by setting PGSYSCONFDIR]
106 Debbugs spool directory; defaults to the value configured in the
107 debbugs configuration file.
111 Output more information about what is happening. Probably not useful
112 if you also set --progress.
120 Display brief useage information.
134 use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers),
135 qw(hash_slice open_compressed_file),);
136 use Debbugs::Config qw(:config);
137 use Debbugs::Status qw(read_bug split_status_fields);
140 use Debbugs::DB::Load qw(:load_bug :load_package :load_suite);
148 use IO::Uncompress::AnyUncompress;
149 use Encode qw(decode_utf8);
150 use List::AllUtils qw(natatime);
159 service => $config{debbugs_db},
163 Getopt::Long::Configure('pass_through');
164 GetOptions(\%options,
170 'spool_dir|spool-dir=s',
173 'debug|d+','help|h|?','man|m');
174 Getopt::Long::Configure('default');
176 pod2usage() if $options{help};
177 pod2usage({verbose=>2}) if $options{man};
179 $DEBUG = $options{debug};
182 ('bugs' => {function => \&add_bugs,
183 arguments => {'preload' => 0},
185 'versions' => {function => \&add_versions,
187 'debinfo' => {function => \&add_debinfo,
188 arguments => {'0|null' => 0,
189 'debinfo_dir|debinfo-dir=s' => 0,
192 'maintainers' => {function => \&add_maintainers,
194 'configuration' => {function => \&add_configuration,
196 'suites' => {function => \&add_suite,
197 arguments => {'ftpdists=s' => 1,
200 'logs' => {function => \&add_logs,
202 'bugs_and_logs' => {function => \&add_bugs_and_logs,
204 'packages' => {function => \&add_packages,
205 arguments => {'ftpdists=s' => 1,
209 'help' => {function => sub {pod2usage({verbose => 2});}}
213 $options{verbose} = $options{verbose} - $options{quiet};
215 if ($options{progress}) {
216 eval "use Term::ProgressBar";
217 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
221 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
223 if (exists $options{sysconfdir}) {
224 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
225 delete $ENV{PGSYSCONFDIR};
227 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
231 if (exists $options{spool_dir} and defined $options{spool_dir}) {
232 $config{spool_dir} = $options{spool_dir};
236 if ($options{progress}) {
237 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
238 warn "Unable to initialize progress bar: $@" if not $prog_bar;
242 my ($subcommand) = shift @ARGV;
243 if (not defined $subcommand) {
244 $subcommand = 'help';
245 print STDERR "You must provide a subcommand; displaying usage.\n";
247 } elsif (not exists $subcommands{$subcommand}) {
248 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
252 binmode(STDOUT,':encoding(UTF-8)');
253 binmode(STDERR,':encoding(UTF-8)');
256 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
257 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
260 my ($options,$opts,$p,$config,$argv) = @_;
261 chdir($config->{spool_dir}) or
262 die "chdir $config->{spool_dir} failed: $!";
264 my $verbose = $options->{debug};
266 my $initialdir = "db-h";
268 if (defined $argv->[0] and $argv->[0] eq "archive") {
269 $initialdir = "archive";
271 my $s = db_connect($options);
278 if ($opts->{preload}) {
280 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
289 $s->resultset('Bug')->quick_insert_bugs(@bugs);
291 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
298 if ($options{quick}) {
300 bugs_to_update($s,$initialdir,@bugs);
302 @bugs_to_update = @bugs;
306 for my $bug (@bugs_to_update) {
310 severities => \%severities,
316 die "failure while trying to load bug: $@";
321 handle_load_bug_queue(db => $s,
326 my ($options,$opts,$p,$config,$argv) = @_;
328 my $s = db_connect($options);
330 my @files = @{$argv};
331 $p->target(scalar @files) if $p;
332 for my $file (@files) {
333 my $fh = IO::File->new($file,'r') or
334 die "Unable to open $file for reading: $!";
339 next unless length $_;
340 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
341 push @versions, [$1,$2];
346 for my $i (reverse 0..($#versions)) {
348 if (not defined $src_pkgs{$versions[$i][0]}) {
349 $src_pkgs{$versions[$i][0]} =
350 $s->resultset('SrcPkg')->
351 get_src_pkg_id($versions[$i][0]);
353 $sp = $src_pkgs{$versions[$i][0]};
354 # There's probably something wrong if the source package
355 # doesn't exist, but we'll skip it for now
356 last if not defined $sp;
357 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
358 ver => $versions[$i][1],
360 last if not defined $sv;
361 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
362 $sv->update({based_on => $ancestor_sv})
364 $ancestor_sv = $sv->id();
372 my ($options,$opts,$p,$config,$argv) = @_;
374 my @files = @{$argv};
375 if (exists $opts->{debinfo_dir} and not @files) {
377 if (-f $_ and /\.debinfo$/) {
378 push @files, $File::Find::name;
387 local $/ = "\0" if $opts->{0};
389 s/\n$// unless $opts->{0};
390 s/\0$// if $opts->{0};
395 return unless @files;
396 my $s = db_connect($options);
397 $p->target(scalar @files) if $p;
398 my $it = natatime 100, @files;
399 while (my @v = $it->()) {
402 FILE: for my $file (@v) {
403 my $fh = IO::File->new($file,'r') or
404 die "Unable to open $file for reading: $!";
405 my $f_stat = stat($file);
406 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
410 next unless length $_;
411 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
412 # if $srcver is not defined, this is probably a broken
413 # .debinfo file [they were causing #686106, see commit
414 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
415 # the file, so we'll fudge it from the filename.
416 if (not defined $srcver) {
417 ($srcname,$srcver) = ($binarch,$srcname);
418 ($binarch) = $file =~ /_([a-z0-9-]+)\.debinfo/;
420 # It turns out that there are debinfo files which are horribly
421 # screwed up, and have junk in them. We need to discard them
423 if (not defined $srcname or
424 not defined $srcver or
425 not defined $binname or
426 not defined $binver or
427 $srcname !~ /^$config{package_name_re}$/o or
428 $binname !~ /^$config{package_name_re}$/o or
429 $srcver !~ /^$config{package_version_re}$/o or
430 $binver !~ /^$config{package_version_re}$/o
432 print STDERR "malformed debinfo: $file\n";
436 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
443 for my $di (@debinfos) {
444 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
447 $p->update($p->last_update()+@v) if $p;
452 sub add_maintainers {
453 my ($options,$opts,$p,$config,$argv) = @_;
455 my $s = db_connect($options);
456 my $maintainers = getsourcemaintainers() // {};
458 ## get all of the maintainers, and add the missing ones
459 my $maints = $s->resultset('Maintainer')->
460 get_maintainers(values %{$maintainers});
462 my @svs = $s->resultset('SrcVer')->
463 search({maintainer => undef
466 group_by => 'me.src_pkg, src_pkg.pkg',
467 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
468 columns => [qw(me.src_pkg src_pkg.pkg)],
471 $p->target(2+@svs) if $p;
474 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
475 my $pkg = $sv->{src_pkg}{pkg};
476 my $maint = $maints->
477 {$maintainers->{$pkg}};
478 $s->txn_do(sub {$s->resultset('SrcVer')->
479 search({maintainer => undef,
480 'src_pkg.pkg' => $pkg
483 )->update({maintainer => $maint})
491 sub add_configuration {
492 my ($options,$opts,$p,$config,$argv) = @_;
494 my $s = db_connect($options);
499 for my $tag (@{$config{tags}}) {
501 $s->resultset('Tag')->find_or_create({tag => $tag});
504 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
505 next if exists $tags{$tag->tag};
513 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
514 # add all severitites
515 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
516 # mark strong severities
517 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
520 $sev->ordering($order);
523 $sev_names{$sev_name} = 1;
525 # mark obsolete severities
526 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
527 next if exists $sev_names{$sev->severity()};
534 my ($options,$opts,$p,$config,$argv) = @_;
537 my $s = db_connect($options);
538 my $dist_dir = IO::Dir->new($opts->{ftpdists});
540 grep { $_ !~ /^\./ and
541 -d $opts->{ftpdists}.'/'.$_ and
542 not -l $opts->{ftpdists}.'/'.$_
544 while (my $dist = shift @dist_names) {
545 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
546 my ($dist_info,$package_files) =
547 read_release_file($dist_dir.'/Release');
548 load_suite($s,$dist_info);
553 my ($options,$opts,$p,$config,$argv) = @_;
555 chdir($config->{spool_dir}) or
556 die "chdir $config->{spool_dir} failed: $!";
558 my $verbose = $options->{debug};
560 my $initialdir = "db-h";
562 if (defined $argv->[0] and $argv->[0] eq "archive") {
563 $initialdir = "archive";
565 my $s = db_connect($options);
567 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
573 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
574 if (not defined $stat) {
575 print STDERR "Unable to stat $bug $!\n";
578 if ($options{quick}) {
579 my $rs = $s->resultset('Bug')->
580 search({id=>$bug})->single();
581 return if defined $rs and
582 $stat->mtime <= $rs->last_modified()->epoch();
585 load_bug_log(db => $s,
589 die "failure while trying to load bug log $bug\n$@";
594 sub add_bugs_and_logs {
595 my ($options,$opts,$p,$config,$argv) = @_;
597 chdir($config->{spool_dir}) or
598 die "chdir $config->{spool_dir} failed: $!";
600 my $verbose = $options->{debug};
602 my $initialdir = "db-h";
604 if (defined $argv->[0] and $argv->[0] eq "archive") {
605 $initialdir = "archive";
607 my $s = db_connect($options);
613 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
620 if ($options{quick}) {
622 bugs_to_update($s,$initialdir,@bugs);
624 @bugs_to_update = @bugs;
628 for my $bug (@bugs_to_update) {
632 severities => \%severities,
638 die "failure while trying to load bug: $@";
640 for my $bug (@bugs) {
641 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
642 if (not defined $stat) {
643 print STDERR "Unable to stat $bug $!\n";
646 if ($options{quick}) {
647 my $rs = $s->resultset('Bug')->
648 search({id=>$bug})->single();
649 return if defined $rs and
650 $stat->mtime <= $rs->last_modified()->epoch();
653 load_bug_log(db => $s,
657 die "failure while trying to load bug log $bug\n$@";
663 handle_load_bug_queue(db=>$s,
670 my ($options,$opts,$p,$config,$argv) = @_;
672 my $dist_dir = IO::Dir->new($opts->{ftpdists});
674 grep { $_ !~ /^\./ and
675 -d $opts->{ftpdists}.'/'.$_ and
676 not -l $opts->{ftpdists}.'/'.$_
679 while (my $dist = shift @dist_names) {
680 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
681 my ($dist_info,$package_files) =
682 read_release_file($dist_dir.'/Release');
683 $s_p{$dist_info->{Codename}} = $package_files;
686 for my $suite (keys %s_p) {
687 for my $component (keys %{$s_p{$suite}}) {
688 $tot += scalar keys %{$s_p{$suite}{$component}};
691 $p->target($tot) if $p;
694 my $tot_suites = scalar keys %s_p;
696 my $completed_pkgs=0;
697 # parse packages files
698 for my $suite (keys %s_p) {
700 for my $component (keys %{$s_p{$suite}}) {
701 my @archs = keys %{$s_p{$suite}{$component}};
702 if (grep {$_ eq 'source'} @archs) {
703 @archs = ('source',grep {$_ ne 'source'} @archs);
705 for my $arch (@archs) {
706 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
707 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
709 local $/ = ''; # paragraph mode
712 for my $field (qw(Package Maintainer Version Source)) {
713 /^\Q$field\E: (.*)/m;
716 next unless defined $pkg{Package} and
717 defined $pkg{Version};
718 push @pkgs,[$arch,$component,\%pkg];
722 my $s = db_connect($options);
726 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
727 $completed_pkgs+@pkgs) if $p;
732 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
733 $completed_pkgs += @pkgs;
739 sub handle_subcommand_arguments {
740 my ($argv,$args) = @_;
742 Getopt::Long::GetOptionsFromArray($argv,
747 for my $arg (keys %{$args}) {
748 next unless $args->{$arg};
749 my $r_arg = $arg; # real argument name
750 $r_arg =~ s/[=\|].+//g;
751 if (not defined $subopt->{$r_arg}) {
752 push @usage_errors, "You must give a $r_arg option";
755 pod2usage(join("\n",@usage_errors)) if @usage_errors;
760 my ($subcommand,$config,$options) = @_;
761 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
762 if ($options->{quick}) {
763 # If this is a quick run, just exit
764 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
767 print STDERR "Another debbugs-loadsql is running; stopping\n";
774 # connect to the database; figure out how to handle errors
776 my $s = Debbugs::DB->connect($options->{dsn} //
777 $options->{service}) or
778 die "Unable to connect to database: ";
781 sub read_release_file {
784 my $rfh = open_compressed_file($file) or
785 die "Unable to open $file for reading: $!";
791 if (s/^(\S+):\s*//) {
792 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
799 my ($sha,$size,$f) = split /\s+/,$_;
800 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
801 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
802 my ($component,$arch,$package_source) = ($1,$2,$3);
803 $arch =~ s/binary-//;
804 next if exists $p_f{$component}{$arch};
805 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
808 return (\%dist_info,\%p_f);
812 my ($dirs,$p,$what,$verbose,$sub,$n) = @_;
814 my $tot_dirs = @dirs;
816 my $avg_subfiles = 0;
817 my $completed_files = 0;
819 while (my $dir = shift @dirs) {
820 printf "Doing dir %s ...\n", $dir if $verbose;
822 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
823 my @subdirs = readdir(DIR);
826 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
828 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
830 if ($avg_subfiles == 0) {
831 $avg_subfiles = @list;
834 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
835 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
838 my $it = natatime $n,@list;
839 while (my @bugs = $it->()) {
841 $completed_files += scalar @bugs;
842 $p->update($completed_files) if $p;
843 print "Up to $completed_files bugs...\n"
844 if ($completed_files % 100 == 0 && $verbose);
852 my ($s,$initialdir,@bugs) = @_;
854 for my $bug (@bugs) {
855 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
856 if (not defined $stat) {
857 print STDERR "Unable to stat $bug $!\n";
860 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
861 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
862 push @bugs_to_update, $bug;