1 #!/usr/bin/env perl |
|
2 |
|
3 use strict; |
|
4 use warnings FATAL => 'all'; |
|
5 use integer; |
|
6 use Data::Dumper; |
|
7 use Getopt::Long qw(:config no_ignore_case); |
|
8 use File::Copy; |
|
9 use Text::Wrap; |
|
10 use File::Basename; |
|
11 use Cwd; |
|
12 use POSIX qw(strftime); |
|
13 |
|
14 sub blab { |
|
15 print 'debmaker: ', @_, "\n"; |
|
16 } |
|
17 sub warning { |
|
18 blab 'WARNING: ', @_; |
|
19 sleep 2; |
|
20 } |
|
21 sub fatal { |
|
22 blab 'FATAL: ', @_; |
|
23 exit 1; |
|
24 } |
|
25 sub my_chdir { |
|
26 my ($path) = @_; |
|
27 chdir $path or fatal "Can't chdir() to `$path': $!"; |
|
28 } |
|
29 sub my_symlink { |
|
30 my ($src, $dst) = @_; |
|
31 symlink $src, $dst |
|
32 or fatal "Can't create symlink `$src' -> `$dst': $!" |
|
33 } |
|
34 sub my_hardlink { |
|
35 my ($src, $dst) = @_; |
|
36 |
|
37 # For harlink creating target file must be accessible: |
|
38 my $pwd = getcwd; |
|
39 my $dir = dirname $dst; |
|
40 my_chdir $dir; |
|
41 link $src, $dst |
|
42 or fatal "Can't create hardlink `$src' -> `$dst': $!"; |
|
43 my_chdir $pwd; |
|
44 } |
|
45 sub my_copy { |
|
46 my ($src, $dst) = @_; |
|
47 copy $src, $dst |
|
48 or fatal "Can't copy `$src' to `$dst': $!"; |
|
49 } |
|
50 sub my_chown { |
|
51 my ($u, $g, $path) = @_; |
|
52 my $uid = getpwnam $u; |
|
53 my $gid = getgrnam $g; |
|
54 chown $uid, $gid, $path |
|
55 or fatal "Can't chown ($u.$g) `$path': $!"; |
|
56 } |
|
57 sub my_chmod { |
|
58 my ($mode, $path) = @_; |
|
59 chmod oct($mode), $path |
|
60 or fatal "Can't chmod ($mode) `$path': $!"; |
|
61 } |
|
62 sub my_mkdir { |
|
63 my ($path, $mode) = @_; |
|
64 if (defined $mode) { |
|
65 mkdir $path, oct($mode) |
|
66 or fatal "Can't create dir `$path' with mode `$mode': $!"; |
|
67 } else{ |
|
68 mkdir $path |
|
69 or fatal "Can't create dir `$path': $!"; |
|
70 } |
|
71 } |
|
72 sub uniq { |
|
73 my ($array_ref) = @_; |
|
74 my %hash = map { $_, 1 } @$array_ref; |
|
75 @$array_ref = keys %hash; |
|
76 } |
|
77 |
|
78 sub shell_exec { |
|
79 my ($cmd) = @_; |
|
80 blab "executing `$cmd'"; |
|
81 system($cmd); |
|
82 if ($? == -1) { |
|
83 fatal "failed to execute: $!"; |
|
84 } elsif ($? & 127) { |
|
85 fatal (printf "child died with signal %d, %s coredump", |
|
86 ($? & 127), ($? & 128) ? 'with' : 'without') |
|
87 } else { |
|
88 my $rc = $? >> 8; |
|
89 if ($rc != 0) { |
|
90 warning "child exited with value $rc"; |
|
91 } |
|
92 } |
|
93 } |
|
94 sub get_command_line { |
|
95 my ($map_ref, $hash_ref) = @_; |
|
96 my $res = ''; |
|
97 foreach my $k (keys %$map_ref) { |
|
98 $res .= " $$map_ref{$k} '$$hash_ref{$k}'" if exists $$hash_ref{$k}; |
|
99 } |
|
100 return $res; |
|
101 } |
|
102 sub write_file { |
|
103 my ($filename, $content) = @_; |
|
104 blab "Writing file `$filename'"; |
|
105 if (open FD, '>', $filename) { |
|
106 print FD $content; |
|
107 close FD; |
|
108 } else { |
|
109 fatal "Can't write to file `$filename': $!" |
|
110 } |
|
111 } |
|
112 sub write_script { |
|
113 my ($filename, $content) = @_; |
|
114 $content = "#!/bin/sh\nset -e\n$content"; |
|
115 write_file $filename, $content; |
|
116 my_chmod '0555', $filename; |
|
117 } |
|
118 |
|
119 sub get_output { |
|
120 my ($cmd) = @_; |
|
121 if (open OUT, "$cmd |") { |
|
122 my @lines = <OUT>; |
|
123 close OUT; |
|
124 chomp @lines; |
|
125 warning "Empty output from `$cmd'" unless @lines; |
|
126 return \@lines; |
|
127 } else { |
|
128 fatal "Can't execute `$cmd': $!" |
|
129 } |
|
130 } |
|
131 sub get_output_line { |
|
132 return (@{get_output @_})[0]; |
|
133 } |
|
134 |
|
135 sub trim { |
|
136 # works with refs: |
|
137 $$_ =~ s/^\s*(.*)\s*$/$1/ foreach @_; |
|
138 } |
|
139 |
|
140 |
|
141 # Expected input for @PROTO_DIRS: |
|
142 # -d /root/oi-build/components/elinks/build/prototype/i386/mangled |
|
143 # -d /root/oi-build/components/elinks/build/prototype/i386 |
|
144 # -d . |
|
145 # -d /root/oi-build/components/elinks |
|
146 # -d elinks-0.11.7 |
|
147 # (like debian/tmp) |
|
148 my @PROTO_DIRS = (); |
|
149 |
|
150 # Where to create debs prototypes |
|
151 # (like debian/pkg-name) |
|
152 my $DEBS_DIR = ''; |
|
153 |
|
154 # If true, will use manifests from command line |
|
155 # to resolve dependencies: |
|
156 my $BOOTSTRAP = 0; |
|
157 |
|
158 my $MAINTAINER = 'Nexenta Systems <[email protected]>'; |
|
159 my $VERSION = '0.0.0'; |
|
160 my $ARCH = 'solaris-i386'; |
|
161 my $SOURCE = 'xxx'; # only for *.changes |
|
162 my $DISTRIB = 'unstable'; # only for *.changes |
|
163 |
|
164 # Mapping file => IPS FMRI, filled on bootstrap: |
|
165 my %PATHS = (); |
|
166 |
|
167 GetOptions ( |
|
168 'd=s' => \@PROTO_DIRS, |
|
169 'D=s' => \$DEBS_DIR, |
|
170 'V=s' => \$VERSION, |
|
171 'A=s' => \$ARCH, |
|
172 'M=s' => \$MAINTAINER, |
|
173 'S=s' => \$SOURCE, |
|
174 'N=s' => \$DISTRIB, |
|
175 'bootstrap!' => \$BOOTSTRAP, |
|
176 'help|h' => sub {usage()}, |
|
177 ) or usage(); |
|
178 |
|
179 sub usage { |
|
180 print <<USAGE; |
|
181 Usage: $0 [options] -D <output dir> -d <proto dir> [-d <proto dir> ... ] manifests |
|
182 |
|
183 Options: |
|
184 |
|
185 -d <proto dir> where to find files (like debian/tmp) |
|
186 |
|
187 -D <output dir> where to create package structure and debs, |
|
188 <output dir>/pkg-name and |
|
189 <output dir>/pkg-name*.deb will be created |
|
190 |
|
191 -V <version> version of created packages (default is `$VERSION'), |
|
192 may be 'ips' to use the same as for IPS system. |
|
193 |
|
194 -A <architecture> package architecture, default is `$ARCH' |
|
195 |
|
196 -S <source name> package source name to make reprepro happy |
|
197 with *.changes files, default is `$SOURCE' |
|
198 |
|
199 -N <dist name> distribution name to make reprepro happy |
|
200 with *.changes files, default is `$DISTRIB' |
|
201 |
|
202 -M <maintainer> Package maintainer - mandatory for debs, |
|
203 default is `$MAINTAINER' |
|
204 |
|
205 --bootstrap Search for dependencies within listed manifests, |
|
206 not within installed system (for bootstraping) |
|
207 ** not implemented yet ** |
|
208 |
|
209 -h, --help Show help info |
|
210 |
|
211 USAGE |
|
212 exit 1; |
|
213 } |
|
214 |
|
215 sub parse_keys { |
|
216 my ($line) = @_; |
|
217 # parse: |
|
218 # name=pkg.summary value="advanced text-mode WWW browser" |
|
219 # into: |
|
220 # 'name' => pkg.summary |
|
221 # 'value' => "advanced text-mode WWW browser" |
|
222 # http://stackoverflow.com/questions/168171/regular-expression-for-parsing-name-value-pairs |
|
223 # TODO: add support for dublicates: dir=dir1 dir=dir2 |
|
224 my %pairs = ($line =~ m/((?:\\.|[^= ]+)*)=("(?:\\.|[^"\\]+)*"|(?:\\.|[^ "\\]+)*)/g); |
|
225 foreach my $k (keys %pairs) { |
|
226 $pairs{$k} =~ s/^"(.+)"$/$1/; |
|
227 } |
|
228 return \%pairs; |
|
229 } |
|
230 |
|
231 sub read_manifest { |
|
232 my ($filename) = @_; |
|
233 my %data = (); |
|
234 $data{'dir'} = []; |
|
235 $data{'file'} = []; |
|
236 $data{'link'} = []; |
|
237 $data{'hardlink'} = []; |
|
238 $data{'depend'} = []; |
|
239 $data{'legacy'} = []; |
|
240 $data{'group'} = []; |
|
241 $data{'user'} = []; |
|
242 $data{'license'} = []; |
|
243 |
|
244 if (open IN, '<', $filename) { |
|
245 while (<IN>) { |
|
246 study; chomp; |
|
247 if (/^set +/) { |
|
248 my $pairs = parse_keys $_; |
|
249 $data{$$pairs{'name'}} = $$pairs{'value'}; |
|
250 } elsif (/^dir +/) { |
|
251 my $pairs = parse_keys $_; |
|
252 push @{$data{'dir'}}, $pairs; |
|
253 } elsif (/^file +(\S+) +/) { |
|
254 my $maybe_src = $1; |
|
255 my $pairs = parse_keys $_; |
|
256 $$pairs{'src'} = $maybe_src if $maybe_src ne 'NOHASH'; |
|
257 push @{$data{'file'}}, $pairs; |
|
258 } elsif (/^link +/) { |
|
259 my $pairs = parse_keys $_; |
|
260 push @{$data{'link'}}, $pairs; |
|
261 } elsif (/^hardlink +/) { |
|
262 my $pairs = parse_keys $_; |
|
263 push @{$data{'hardlink'}}, $pairs; |
|
264 } elsif (/^depend +/) { |
|
265 my $pairs = parse_keys $_; |
|
266 push @{$data{'depend'}}, $pairs; |
|
267 } elsif (/^legacy +/) { |
|
268 my $pairs = parse_keys $_; |
|
269 push @{$data{'legacy'}}, $pairs; |
|
270 } elsif (/^group +/) { |
|
271 my $pairs = parse_keys $_; |
|
272 push @{$data{'group'}}, $pairs; |
|
273 } elsif (/^user +/) { |
|
274 my $pairs = parse_keys $_; |
|
275 push @{$data{'user'}}, $pairs; |
|
276 } elsif (/^license +(\S+) +/) { |
|
277 my $maybe_src = $1; |
|
278 my $pairs = parse_keys $_; |
|
279 $$pairs{'src'} = $maybe_src if $maybe_src !~ /=/; |
|
280 push @{$data{'license'}}, $pairs; |
|
281 } elsif (/^\s*$/) { |
|
282 # Skip empty lines |
|
283 } elsif (/^\s*#/) { |
|
284 # Skip comments |
|
285 } else { |
|
286 warning "Unknown action: `$_'"; |
|
287 } |
|
288 # TODO: |
|
289 # user - to create users (in postinstall?) |
|
290 # restart_fmri - restart SMF |
|
291 } |
|
292 close IN; |
|
293 return \%data; |
|
294 } else { |
|
295 fatal "Can't open `$filename': $!"; |
|
296 } |
|
297 } |
|
298 |
|
299 sub get_debpkg_names { |
|
300 # pkg:/web/browser/[email protected],5.11-1.1 |
|
301 # => web-browser-elinks |
|
302 # browser-elinks |
|
303 # elinks |
|
304 # Also works for "original_name"=pkg:/web/browser/elinks:usr/bin/Elinks |
|
305 my ($fmri) = @_; |
|
306 my @names = (); |
|
307 if ($fmri =~ m,^(?:pkg:/)?([^:@]+)(?:[:@].+)?$,) { |
|
308 my $pkg = $1; |
|
309 my @parts = split /\//, $pkg; |
|
310 while (@parts) { |
|
311 push @names, (join '-', @parts); |
|
312 shift @parts; |
|
313 } |
|
314 return @names; |
|
315 } else { |
|
316 fatal "Can't parse FMRI to get dpkg name: `$fmri'"; |
|
317 } |
|
318 } |
|
319 sub get_debpkg_name { |
|
320 return (get_debpkg_names @_)[0] |
|
321 } |
|
322 |
|
323 sub get_ips_version { |
|
324 # pkg:/web/browser/[email protected],5.11-1.1 |
|
325 # => 0.11.5-5.11-1.1 |
|
326 my ($fmri) = @_; |
|
327 if ($fmri =~ m,^(?:pkg:/)?[^@]+@(.+)$,) { |
|
328 my $ips = $1; |
|
329 $ips =~ s/[,:]/-/g; |
|
330 return $ips; |
|
331 } else { |
|
332 fatal "Can't parse FMRI to get IPS version: `$fmri'"; |
|
333 } |
|
334 } |
|
335 |
|
336 sub get_pkg_section { |
|
337 my ($pkgname) = @_; |
|
338 if ($pkgname =~ m,^([^-@]+)-.*,) { |
|
339 return (split /-/, $pkgname)[0]; |
|
340 } elsif ($pkgname =~ m,^pkg:/([^/]+)/.*,) { |
|
341 return $1; |
|
342 } else { |
|
343 fatal "Can't get section for package `$pkgname'" |
|
344 } |
|
345 } |
|
346 |
|
347 sub get_dir_size { |
|
348 my ($path) = @_; |
|
349 # We get size just after files are copied |
|
350 # and need sync() to get proper sizes: |
|
351 my $out = get_output("sync && du -sk $path | cut -f 1"); |
|
352 return $$out[0]; |
|
353 } |
|
354 |
|
355 sub find_pkgs_with_paths { |
|
356 my @paths = @_; |
|
357 s,^/+,,g foreach @paths; |
|
358 my $dpkg = get_output('dpkg-query --search -- ' . join(' ', @paths) . ' | cut -d: -f1'); |
|
359 return $dpkg; |
|
360 } |
|
361 |
|
362 sub guess_required_deps { |
|
363 my ($path) = @_; |
|
364 my $elfs = get_output("find $path -type f -exec file {} \\; | grep ELF | cut -d: -f1"); |
|
365 my @deps = (); |
|
366 if (@$elfs) { |
|
367 # my $libs = get_output('ldd ' . join(' ', @$elfs) . ' | grep "=>"'); |
|
368 my $libs = get_output('elfdump -d ' . join(' ', @$elfs) . ' | grep NEEDED | awk \'{print $4}\''); |
|
369 uniq $libs; |
|
370 my $pkgs = find_pkgs_with_paths @$libs; |
|
371 push @deps, @$pkgs; |
|
372 } |
|
373 return \@deps; |
|
374 } |
|
375 |
|
376 |
|
377 if (!$DEBS_DIR) { |
|
378 fatal "Output dir is not set. Use -D option." |
|
379 } |
|
380 if (! -d $DEBS_DIR) { |
|
381 fatal "Not a directory: `$DEBS_DIR'" |
|
382 } |
|
383 |
|
384 # Walk through all manifests |
|
385 # and collect files, symlinks, hardlink |
|
386 # mapping them to package names: |
|
387 if ($BOOTSTRAP) { |
|
388 blab "Bootstrap: collecting paths ..."; |
|
389 foreach my $manifest_file (@ARGV) { |
|
390 my $manifest_data = read_manifest $manifest_file; |
|
391 my $fmri = $$manifest_data{'pkg.fmri'}; |
|
392 my @items = (); |
|
393 if (my @files = @{$$manifest_data{'file'}}) { |
|
394 push @items, @files; |
|
395 } |
|
396 if (my @symlinks = @{$$manifest_data{'link'}}) { |
|
397 push @items, @symlinks; |
|
398 } |
|
399 if (my @hardlinks = @{$$manifest_data{'hardlink'}}) { |
|
400 push @items, @hardlinks; |
|
401 } |
|
402 foreach my $item (@items) { |
|
403 my $path = $$item{'path'}; |
|
404 if (exists $PATHS{$path}) { |
|
405 warning "`$path' already present in `$PATHS{$path}' and now found in `$fmri' (manifest `$manifest_file')" |
|
406 } else { |
|
407 $PATHS{$path} = $fmri; |
|
408 } |
|
409 } |
|
410 } |
|
411 blab 'Bootstrap: ' . (keys %PATHS) . ' known paths' |
|
412 } |
|
413 |
|
414 |
|
415 my %changes = (); |
|
416 $changes{'Date'} = strftime '%a, %d %b %Y %T %z', localtime; # Sat, 11 Jun 2011 17:08:17 +0200 |
|
417 $changes{'Architecture'} = $ARCH; |
|
418 $changes{'Format'} = '1.8'; |
|
419 $changes{'Maintainer'} = $MAINTAINER; |
|
420 $changes{'Source'} = lc $SOURCE; |
|
421 $changes{'Version'} = $VERSION; |
|
422 $changes{'Distribution'} = $DISTRIB; |
|
423 $changes{'Changes'} = 'Everything has changed'; |
|
424 $changes{'Description'} = ''; |
|
425 $changes{'Checksums-Sha1'} = ''; |
|
426 $changes{'Checksums-Sha256'} = ''; |
|
427 $changes{'Files'} = ''; |
|
428 $changes{'Binary'} = ''; |
|
429 |
|
430 |
|
431 foreach my $manifest_file (@ARGV) { |
|
432 blab "****** Manifest: `$manifest_file'"; |
|
433 my $manifest_data = read_manifest $manifest_file; |
|
434 my @provides = get_debpkg_names $$manifest_data{'pkg.fmri'}; |
|
435 my $debname = shift @provides; # main name (web-browser-elinks) |
|
436 my $debsection = get_pkg_section $debname; |
|
437 my $debpriority = exists $$manifest_data{'pkg.priority'} ? $$manifest_data{'pkg.priority'} : 'optional'; |
|
438 my @replaces = (); |
|
439 |
|
440 foreach my $l (@{$$manifest_data{'legacy'}}) { |
|
441 push @provides, get_debpkg_name $$l{'pkg'}; |
|
442 } |
|
443 my $pkgdir = "$DEBS_DIR/$debname"; |
|
444 blab "Main package name: $debname"; |
|
445 |
|
446 my $ipsversion = get_ips_version $$manifest_data{'pkg.fmri'}; |
|
447 my $debversion = undef; |
|
448 if ($VERSION eq 'ips') { |
|
449 blab "Using IPS version scheme: $ipsversion"; |
|
450 $debversion = $ipsversion; |
|
451 } else { |
|
452 blab "Using given version: $VERSION"; |
|
453 $debversion = $VERSION; |
|
454 } |
|
455 |
|
456 # Make sure to work with empty tree: |
|
457 # mkdir will fail if dir exists |
|
458 my_mkdir $pkgdir; |
|
459 |
|
460 # Believe that dirs are listed in proper order: |
|
461 # usr, usr/bin, etc |
|
462 if (my @dirs = @{$$manifest_data{'dir'}}) { |
|
463 blab "Making dirs ..."; |
|
464 foreach my $dir (@dirs) { |
|
465 my $dir_name = "$pkgdir/$$dir{'path'}"; |
|
466 my_mkdir $dir_name, $$dir{'mode'}; |
|
467 my_chown $$dir{'owner'}, $$dir{'group'}, $dir_name; |
|
468 push @replaces, get_debpkg_name $$dir{original_name} if exists $$dir{original_name}; |
|
469 } |
|
470 } |
|
471 |
|
472 my @conffiles = (); |
|
473 if (my @files = @{$$manifest_data{'file'}}) { |
|
474 blab "Copying files ..."; |
|
475 foreach my $file (@files) { |
|
476 my $dst = "$pkgdir/$$file{'path'}"; |
|
477 my $src = exists $$file{'src'} ? $$file{'src'} : $$file{'path'}; |
|
478 # find $src in @PROTO_DIRS: |
|
479 my $src_dir = undef; |
|
480 foreach my $d (@PROTO_DIRS) { |
|
481 # http://stackoverflow.com/questions/2238576/what-is-the-default-scope-of-foreach-loop-in-perl |
|
482 $src_dir = $d; |
|
483 last if -f "$src_dir/$src"; |
|
484 } |
|
485 fatal "file `$src' not found in ", join(', ', @PROTO_DIRS) |
|
486 unless $src_dir; |
|
487 |
|
488 $src = "$src_dir/$src"; |
|
489 my_copy $src, $dst; |
|
490 my_chown $$file{'owner'}, $$file{'group'}, $dst; |
|
491 my_chmod $$file{'mode'}, $dst; |
|
492 |
|
493 push @conffiles, $$file{'path'} if exists $$file{'preserve'}; |
|
494 push @replaces, get_debpkg_name $$file{original_name} if exists $$file{original_name}; |
|
495 } |
|
496 } |
|
497 |
|
498 if (my @hardlinks = @{$$manifest_data{'hardlink'}}) { |
|
499 blab "Creating hardlinks ..."; |
|
500 foreach my $link (@hardlinks) { |
|
501 my_hardlink $$link{'target'}, "$pkgdir/$$link{'path'}"; |
|
502 } |
|
503 } |
|
504 if (my @symlinks = @{$$manifest_data{'link'}}) { |
|
505 blab "Creating symlinks ..."; |
|
506 foreach my $link (@symlinks) { |
|
507 my_symlink $$link{'target'}, "$pkgdir/$$link{'path'}"; |
|
508 } |
|
509 } |
|
510 |
|
511 if (my @license = @{$$manifest_data{'license'}}) { |
|
512 # FIXME: install in usr/share/doc/<pkg>/copyright |
|
513 # what are the owner, permissions? |
|
514 # multiple licenses? |
|
515 } |
|
516 my $installed_size = get_dir_size($pkgdir); |
|
517 |
|
518 my @depends = (); |
|
519 my @predepends = (); |
|
520 my @recommends = (); |
|
521 my @suggests = (); |
|
522 my @conflicts = (); |
|
523 blab "Getting dependencies ..."; |
|
524 foreach my $dep (@{$$manifest_data{'depend'}}) { |
|
525 if ($$dep{'fmri'} ne '__TBD') { |
|
526 my $dep_pkg = (get_debpkg_names($$dep{'fmri'}))[0]; |
|
527 blab "Dependency: $dep_pkg ($$dep{'type'})"; |
|
528 push @depends, $dep_pkg if $$dep{'type'} eq 'require'; |
|
529 push @predepends, $dep_pkg if $$dep{'type'} eq 'origin'; |
|
530 push @suggests, $dep_pkg if $$dep{'type'} eq 'optional'; |
|
531 push @conflicts, $dep_pkg if $$dep{'type'} eq 'exclude'; |
|
532 } |
|
533 } |
|
534 push @depends, @{guess_required_deps($pkgdir)}; |
|
535 |
|
536 uniq \@depends; |
|
537 uniq \@replaces; |
|
538 uniq \@provides; |
|
539 uniq \@predepends; |
|
540 uniq \@recommends; |
|
541 uniq \@suggests; |
|
542 uniq \@conflicts; |
|
543 # When a program and a library are in the same package: |
|
544 @depends = grep {$_ ne $debname} @depends; |
|
545 |
|
546 |
|
547 my $control = ''; |
|
548 $control .= "Package: $debname\n"; |
|
549 $control .= "Source: $changes{Source}\n"; |
|
550 $control .= "Version: $debversion\n"; |
|
551 $control .= "Section: $debsection\n"; |
|
552 $control .= "Priority: $debpriority\n"; |
|
553 $control .= "Maintainer: $MAINTAINER\n"; |
|
554 $control .= "Architecture: $ARCH\n"; |
|
555 |
|
556 |
|
557 $control .= "Description: $$manifest_data{'pkg.summary'}\n"; |
|
558 $changes{'Description'} .= "\n $debname - $$manifest_data{'pkg.summary'}"; |
|
559 |
|
560 $control .= wrap(' ', ' ', $$manifest_data{'pkg.description'}) . "\n" |
|
561 if exists $$manifest_data{'pkg.description'}; |
|
562 |
|
563 $control .= 'Provides: ' . join(', ', @provides) . "\n" if @provides; |
|
564 $control .= 'Depends: ' . join(', ', @depends) . "\n" if @depends; |
|
565 $control .= 'Pre-Depends: ' . join(', ', @predepends) . "\n" if @predepends; |
|
566 $control .= 'Recommends: ' . join(', ', @recommends) . "\n" if @recommends; |
|
567 $control .= 'Suggests: ' . join(', ', @suggests) . "\n" if @suggests; |
|
568 $control .= 'Conflicts: ' . join(', ', @conflicts) . "\n" if @conflicts; |
|
569 $control .= 'Replaces: ' . join(', ', @replaces) . "\n" if @replaces; |
|
570 |
|
571 $control .= "Installed-Size: $installed_size\n"; |
|
572 |
|
573 $control .= "Origin: $$manifest_data{'info.upstream_url'}\n" |
|
574 if exists $$manifest_data{'info.upstream_url'}; |
|
575 $control .= "X-Source-URL: $$manifest_data{'info.source_url'}\n" |
|
576 if exists $$manifest_data{'info.source_url'}; |
|
577 $control .= "X-FMRI: $$manifest_data{'pkg.fmri'}\n"; |
|
578 |
|
579 my_mkdir "$pkgdir/DEBIAN"; |
|
580 |
|
581 write_file "$pkgdir/DEBIAN/control", $control; |
|
582 |
|
583 if (@conffiles) { |
|
584 write_file "$pkgdir/DEBIAN/conffiles", (join "\n", @conffiles); |
|
585 } |
|
586 |
|
587 my $preinst = ''; |
|
588 my $postinst = ''; |
|
589 my $prerm = ''; |
|
590 my $postrm = ''; |
|
591 if (my @groups = @{$$manifest_data{'group'}}) { |
|
592 foreach my $g (@groups) { |
|
593 my $cmd = "if ! getent group $$g{'groupname'} >/dev/null; then\n"; |
|
594 $cmd .= "echo Adding group $$g{'groupname'}\n"; |
|
595 $cmd .= 'groupadd'; |
|
596 $cmd .= get_command_line { |
|
597 'gid' => '-g' |
|
598 }, $g; |
|
599 $cmd .= " $$g{'groupname'} || true\n"; |
|
600 $cmd .= "fi\n"; |
|
601 $preinst .= $cmd; |
|
602 } |
|
603 } |
|
604 if (my @users = @{$$manifest_data{'user'}}) { |
|
605 foreach my $u (@users) { |
|
606 my $cmd = "if ! getent passwd $$u{'username'} >/dev/null; then\n"; |
|
607 $cmd .= "echo Adding user $$u{'username'}\n"; |
|
608 $cmd .= 'useradd'; |
|
609 $cmd .= get_command_line { |
|
610 'uid' => '-u', |
|
611 'group' => '-g', |
|
612 'gcos-field' => '-c', |
|
613 'home-dir' => '-d', |
|
614 'uid' => '-u', |
|
615 'login-shell' => '-s', |
|
616 'group-list' => '-G', |
|
617 'inactive' => '-f', |
|
618 'expire' => '-e', |
|
619 }, $u; |
|
620 $cmd .= " $$u{'username'} || true\n"; |
|
621 $cmd .= "fi\n"; |
|
622 $preinst .= $cmd; |
|
623 } |
|
624 } |
|
625 |
|
626 write_script "$pkgdir/DEBIAN/preinst", $preinst if $preinst; |
|
627 |
|
628 my $pkg_deb = "${pkgdir}_${debversion}_${ARCH}.deb"; |
|
629 # FIXME: we need GNU tar |
|
630 shell_exec(qq|PATH=/usr/gnu/bin:/usr/bin dpkg-deb -b "$pkgdir" "$pkg_deb"|); |
|
631 |
|
632 my $sha1 = get_output_line "sha1sum $pkg_deb | cut -d' ' -f1"; |
|
633 my $sha256 = get_output_line "sha256sum $pkg_deb | cut -d' ' -f1"; |
|
634 my $md5sum = get_output_line "md5sum $pkg_deb | cut -d' ' -f1"; |
|
635 my $size = (stat $pkg_deb)[7]; |
|
636 my $pkg_deb_base = basename $pkg_deb; |
|
637 |
|
638 $changes{'Checksums-Sha1'} .= "\n $sha1 $size $pkg_deb_base"; |
|
639 $changes{'Checksums-Sha256'} .= "\n $sha256 $size $pkg_deb_base"; |
|
640 $changes{'Files'} .= "\n $md5sum $size $debsection $debpriority $pkg_deb_base"; |
|
641 $changes{'Binary'} .= " $debname"; |
|
642 } |
|
643 |
|
644 my $changes_cnt = join "\n", map {"$_: $changes{$_}"} sort keys %changes; |
|
645 write_file "$DEBS_DIR/$changes{'Source'}.changes", $changes_cnt; |
|
646 |
|