1#!/usr/bin/env perl
2
3use strict;
4use warnings;
5use File::Copy qw(copy);
6use DBI;
7use Data::Dumper;
8
9my $pkg_dbdir = '/var/db/pkg';
10
11
12$|++;
13
14if (-e "/var/db/mport/master.db") {
15  print "Backing up master.db to master.db.orig...";
16  copy("/var/db/mport/master.db", "/var/db/mport/master.db.orig") || die "cp failed: $!\b";
17  print " done.\n";
18} else {
19  system("/usr/libexec/mport.init");
20}
21
22my $dbh = DBI->connect("dbi:SQLite:dbname=/var/db/mport/master.db","","", { RaiseError => 1 });
23
24foreach my $dir (glob("$pkg_dbdir/*")) {
25  my %pkg;
26
27  print "Converting $dir... ";
28
29  @pkg{qw(name version)} = ($dir =~ m:^$pkg_dbdir/(.+)-(.*)$:o);
30
31  $pkg{comment} = slup_file("$dir/+COMMENT");
32  @pkg{qw(assetlist depends conflicts origin prefix)}  = parse_asset_list("$dir/+CONTENTS");
33#  print Dumper(\%pkg);
34
35  copy_infra_files($dir, \%pkg);
36
37  insert_into_database($dbh, \%pkg);
38
39  print "done.\n";
40#  last;
41}
42
43
44$dbh->disconnect;
45
46sub copy_infra_files {
47  my ($dir, $pkg) = @_;
48
49  return unless -e "$dir/+DEINSTALL";
50
51  mkdir("/var/db/mport/infrastructure");
52  mkdir("/var/db/mport/infrastructure/$pkg->{name}-$pkg->{version}");
53
54  copy("$dir/+DEINSTALL", "/var/db/mport/infrastructure/$pkg->{name}-$pkg->{version}/pkg-deinstall") || die "Coping +DEINSTALLED failed: $!\n";
55}
56
57
58sub insert_into_database {
59  my ($dbh, $pkg) = @_;
60
61  $dbh->begin_work;
62
63  my $sth = $dbh->prepare("INSERT INTO packages (pkg, version, origin, lang, date, prefix, comment, status) VALUES (?,?,?,?,?,?,?,?)");
64  $sth->execute($pkg->{name}, $pkg->{version}, $pkg->{origin}, 'en', time, $pkg->{prefix}, $pkg->{comment}, 'clean');
65  $sth->finish;
66
67  $sth = $dbh->prepare("INSERT INTO depends (pkg, depend_pkgname, depend_pkgversion, depend_port) VALUES (?,?,?,?)");
68
69  foreach my $dep (@{$pkg->{depends}}) {
70    $sth->execute($pkg->{name}, $dep->{depend_pkgname}, $dep->{depend_pkgversion}, $dep->{depend_port});
71  }
72
73  $sth->finish;
74
75  $sth = $dbh->prepare("INSERT INTO assets (pkg, type, data, checksum) VALUES (?,?,?,?)");
76
77  foreach my $asset (@{$pkg->{assetlist}}) {
78    $sth->execute($pkg->{name}, $asset->{type}, $asset->{data}, $asset->{checksum});
79  }
80
81  $sth->finish;
82
83  $dbh->commit;
84}
85
86
87sub slup_file {
88  my ($file) = @_;
89
90  my $fh;
91  local $/;
92
93  open($fh, '<', $file) || die "Couldn't open $file: $!\n";
94  my $contents = <$fh>;
95  close($fh) || die "Couldn't close $file: $!\n";
96
97  $contents =~ s/\s*$//;
98
99  return $contents;
100}
101
102sub parse_asset_list {
103  my ($file) = @_;
104
105  my $fh;
106
107  open($fh, '<', $file) || die "couldn't open $file: $!\n";
108
109
110  my @assetlist;
111  my @depends;
112  my @conflicts;
113  my $origin;
114  my $prefix;
115  my $cwd;
116
117  while (<$fh>) {
118    s/\s*$//;
119
120    next if m/^\@(?:name|mtree)/;
121
122    my $asset = {};
123
124    if (m/^\@(\w+) ?(.*)/) {
125      my $type = $1;
126      my $data = $2;
127
128      if ($type eq 'comment') {
129        if (m/MD5:(\S+)/) {
130          $assetlist[-1]->{checksum} = $1;
131        } elsif (m/DEPORIGIN:(\S+)/) {
132          $depends[-1]->{depend_port} = $1;
133        } elsif (m/ORIGIN:(\S+)/) {
134          $origin = $1;
135        }
136
137        next;
138      }
139
140      if ($type eq 'ignore') {
141        # skip next two lines (file line and checksum line)
142        <$fh>;
143        <$fh>;
144        next;
145      }
146
147      if ($type eq 'pkgdep') {
148        $data =~ m/(\S+)-(\S+)/;
149        push(@depends, {depend_pkgname => $1, depend_pkgversion => $2});
150        next;
151      }
152
153      if ($type eq 'conflicts') {
154        push(@conflicts, $data);
155        next;
156      }
157
158      if ($type eq 'cwd') {
159        $cwd = $data;
160
161        $cwd =~ s:/+$::;
162
163        if (!$prefix) {
164          $prefix = $cwd;
165          next;
166        }
167      }
168
169      if ($type eq 'dirrm' || $type eq 'dirrmtry') {
170        $data = "$cwd/$data";
171      }
172
173      $asset->{type} = $type;
174      $asset->{data} = $data;
175    } else {
176      $asset->{type} = 'file';
177      $asset->{data} = "$cwd/$_";
178    }
179
180    $asset->{type} = lookup_asset_type($asset->{type});
181
182    push(@assetlist, $asset);
183  }
184
185  return (\@assetlist, \@depends, \@conflicts, $origin, $prefix);
186}
187
188# This is really hacky right now, needs to be somethign better in the future
189BEGIN {
190  my %types = (
191    ASSET_INVALID => 0,
192    ASSET_FILE => 1,
193    ASSET_CWD => 2,
194    ASSET_CHMOD => 3,
195    ASSET_CHOWN => 4,
196    ASSET_CHGRP => 5,
197    ASSET_COMMENT => 6,
198    ASSET_IGNORE => 7,
199    ASSET_NAME => 8,
200    ASSET_EXEC => 9,
201    ASSET_UNEXEC => 10,
202    ASSET_SRC => 11,
203    ASSET_DISPLY => 12,
204    ASSET_PKGDEP => 13,
205    ASSET_CONFLICTS => 14,
206    ASSET_MTREE => 15,
207    ASSET_DIRRM => 16,
208    ASSET_DIRRMTRY => 17,
209    ASSET_IGNORE_INST => 18,
210    ASSET_OPTION => 19,
211    ASSET_ORIGIN => 20,
212    ASSET_DEPORIGIN => 21,
213    ASSET_NOINST => 22,
214    ASSET_DISPLAY => 23
215  );
216
217  sub lookup_asset_type {
218    my ($type) = @_;
219
220    $type = uc $type;
221
222    $type = "ASSET_" . $type unless $type =~ m/^ASSET_/;
223
224    exists $types{$type} || die "I don't understand type: $type\n";
225
226    return $types{$type};
227  }
228}
229