Update copyright year
[gpg4win.git] / src / make-msi.pl
1 #! /usr/bin/perl -w
2 # make-msi.pl - MSI Installer for Gpg4win.
3 # Copyright (C) 2007, 2019 g10 Code GmbH
4 #
5 # This file is part of Gpg4win.
6 #
7 # Gpg4win is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 2 of the License, or
10 # (at your option) any later version.
11 #
12 # Gpg4win is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
20
21 # FIXME: Here is how to support multiple languages in one MSI package,
22 # using an undocumented feature: Create one MSI package in each
23 # language, then create transformations:
24 # MsiTran.Exe -g foo.en.msi foo.de.msi language.de.mst
25 # Embed these transformations:
26 # CScript.exe WiSubStg.vbs foo.en.msi language.de.mst 1031
27 # Change the summmary informations attribute (with Orca):
28 # Languages = 1033, 1031
29 # Primary language must come first!
30 # http://www.installsite.org/pages/de/artikel/embeddedlang/index.htm
31 # http://forum.installsite.net/index.php?showtopic=16734
32
33 use strict;
34 use warnings;
35 use diagnostics;
36
37 \f
38 # Default language.
39 $::lang = 'en';
40
41 \f
42 sub fail
43 {
44     print STDERR $_[0] . "\n";
45     exit 1;
46 }
47
48 # We use a new product and package code for every build (using pseudo
49 # components), but a single constant upgrade code for all versions.
50 # Note that Windows installer ignores the build part of the version
51 # number (only the first three components are used).
52 #
53 # FIXME: Build upgrade table.
54 #
55 # We take a simplified view: Each file corresponds to exactly one
56 # component.  This means we need to generate GUIDs for these
57 # components and remember them from one installer version to the next.
58 # We do this automatically by means of a support file, make-msi.guids.
59
60 %::guid = ();
61 $::guid_file = 'make-msi.guids';
62 $::guid_changed = 0;
63
64 sub fetch_guids
65 {
66     # FIXME: Check if file exists.
67     open (FILE, "<$::guid_file") or return;
68     while (<FILE>)
69     {
70         next if (/^#/);
71         if (/(\S+)\s+(.+)\s*\r?\n$/)
72         {
73             $::guid{$2} = $1;
74         }
75     }
76     close (FILE);
77 }
78
79
80 sub store_guids
81 {
82     # FIXME: Maybe allow to forget unused GUIDs.
83
84     return if (not $::guid_changed);
85     print STDERR "GUID list stored in $::guid_file changed, please commit!\n";
86     open (FILE, ">$::guid_file.bak") or die;
87     print FILE "# This is an automatically generated file.  DO NOT EDIT.\n";
88     foreach my $file (sort keys %::guid)
89     {
90         print FILE "$::guid{$file} $file\n";
91     }
92     close FILE;
93     rename "$::guid_file.bak", $::guid_file or die;
94 }
95
96
97 sub get_guid
98 {
99     my ($file) = @_;
100     my $guid;
101
102     if (defined $::guid{$file})
103     {
104         return $::guid{$file};
105     }
106     # Need to generate a new GUID.
107     $::guid_changed = 1;
108     $guid = uc `uuidgen`;
109     chomp $guid;
110     $::guid{$file} = $guid;
111     return $guid;
112 }
113
114 \f
115 $::files_file = '';
116
117 # We store the list of included files for temporary packaging, in case
118 # WiX needs to be run on a different system.
119 sub store_files
120 {
121     my ($parser) = @_;
122
123     return if ($::files_file eq '');
124     open (FILE, ">$::files_file") or die;
125     foreach my $name (@{$parser->{pkg_list}})
126     {
127         my $pkg = $parser->{pkgs}->{$name};
128
129         next if ($#{$pkg->{files}} == -1);
130         print FILE (join ("\n", map { "src/" . ($_->{source}) }
131                 @{$pkg->{files}})). "\n";
132     }
133     close FILE;
134 }
135
136 \f
137 sub lang_to_lcid
138 {
139     my ($lang) = @_;
140
141     if ($lang eq 'en')
142     {
143         return 1033;
144     }
145     elsif ($lang eq 'de')
146     {
147         return 1031;
148     }
149     elsif ($lang eq 'ar')
150     {
151         return 1025;
152     }
153     elsif ($lang eq 'es')
154     {
155         return 3082;
156     }
157     elsif ($lang eq 'fr')
158     {
159         return 1036;
160     }
161     elsif ($lang eq 'ru')
162     {
163         return 1049;
164     }
165     else
166     {
167         fail "language $lang not supported";
168     }
169 }
170
171 \f
172 # NSIS parser
173
174 # The parser data structure contains the following members:
175 #
176 # pre_depth: The current nesting depth of preprocessor conditionals.
177 # pre_true:  Depth of the last preprocessor conditional that was true.
178 # pre_symbols: A hash of defined preprocessor symbols.
179 # po: A hash of languages, each a hash of translated strings.
180 # outpath: the current output path.
181 # includedirs: An array of include directories to search through.
182
183 # A couple of variables you can set:
184 $::nsis_parser_warn = 1;
185 $::nsis_parser_debug = 0;
186
187 $::nsis_level_default = 1;
188 $::nsis_level_optional = 1000;
189 $::nsis_level_hidden = 2000;
190
191 # Evaluate an expression.
192 sub nsis_eval
193 {
194     my ($parser, $file, $expr) = @_;
195     my $val = $expr;
196
197     # Resolve outer double quotes, if any.
198     if ($val =~ m/^"/)
199     {
200         if (not $val =~ s/^"(.*)"$/$1/)
201         {
202             fail "$file:$.: unmatched quote in expression: $expr";
203         }
204     }
205
206     my $iter = 0;
207     while ($val =~ m/\$\{([^}]*)\}/)
208     {
209         my $varname = $1;
210         my $varvalue;
211
212         if (exists $parser->{pre_symbols}->{$varname})
213         {
214             $varvalue = $parser->{pre_symbols}->{$varname};
215         }
216         else
217         {
218             fail "$file:$.: undefined variable $varname in expression: $expr";
219         }
220         $val =~ s/\$\{$varname\}/$varvalue/g;
221
222         $iter++;
223         if ($iter > 100)
224         {
225             fail "$file:$.: too many variable expansions in expression: $expr";
226         }
227     }
228
229     #    # FIXME: For now.
230     #    if ($expr =~ m/\$/ or $expr !~ m/^\"/)
231     #    {
232     #   return $expr;
233     #    }
234     #    $val = eval $expr;
235     return $val;
236 }
237
238
239 # Retrieve an evaluated symbol
240 sub nsis_fetch
241 {
242     my ($parser, $symname) = @_;
243
244     return undef if (not exists $parser->{pre_symbols}->{$symname});
245
246     return nsis_eval ($parser, '', $parser->{pre_symbols}->{$symname});
247 }
248
249
250 # Evaluate an expression.
251 sub nsis_translate
252 {
253     my ($parser, $file, $expr) = @_;
254     my $val = $expr;
255     my $iter = 0;
256
257     while ($val =~ m/\$\((.*)\)/)
258     {
259         my $var = $1;
260
261         if (exists $parser->{po}->{$::lang}->{$1})
262         {
263             my $subst = $parser->{po}->{$::lang}->{$1};
264             $val =~ s/\$\($var\)/$subst/g;
265         }
266         else
267         {
268             fail "$file:$.: no translation for $val to language $::lang";
269         }
270         $iter++;
271         if ($iter > 100)
272         {
273             fail "$file:$.: too deep nesting of translations";
274         }
275     }
276
277     # Resolve outer double quotes, if any.
278     $val =~ s/^"(.*)"$/$1/;
279     $val =~ s/\$\r/\r/g;
280     $val =~ s/\$\n/\n/g;
281     $val =~ s/\$\"/"/g;
282
283     return $val;
284 }
285
286
287 # Low level line input.
288 sub nsis_get_line
289 {
290     my ($file) = @_;
291     my $line = '';
292
293     while (<$file>)
294     {
295         $line = $line . $_;
296
297         # Strip leading whitespace.
298         $line =~ s/^\s*//;
299
300         # Strip newline and trailing whitespace.
301         $line =~ s/\s*\r?\n$//;
302
303         # Combine multiple lines connected with backslashes.
304         if ($line =~ m/^(.*)\\$/)
305         {
306             $line = $1 . ' ';
307             next;
308         }
309
310         $_ = $line;
311         last;
312     }
313
314     # Now break up the line into
315     return $_;
316 }
317
318
319 # Tokenize the NSIS line.
320 sub nsis_tokenize
321 {
322     my ($file, $line) = @_;
323     my @tokens;
324
325     my @line = split ('', $line);
326     my $idx = 0;
327
328     while ($idx <= $#line)
329     {
330         # The beginning of the current partial token.
331         my $token = $idx;
332
333         if ($line[$idx] eq '"')
334         {
335             $idx++;
336             # Skip until end of string, indicated by double quote that
337             # is not part of the $\" string.
338             while ($idx <= $#line)
339             {
340                 if (substr ($line, $idx, 3) eq '$\\"')
341                 {
342                     $idx += 3;
343                 }
344                 else
345                 {
346                     last if ($line[$idx] eq '"');
347                     $idx++;
348                 }
349             }
350             fail "$file:$.:$idx: unterminated string from position $token"
351             if ($idx > $#line);
352             $idx++;
353             fail "$file:$.:$idx: strings not separated"
354             if ($idx <= $#line and $line[$idx] !~ m/\s/);
355         }
356         elsif ($line[$idx] eq '\'')
357         {
358             $idx++;
359             # Skip until end of string, indicated by a single quote.
360             while ($idx <= $#line)
361             {
362                 last if ($line[$idx] eq '\'');
363                 $idx++;
364             }
365             fail "$file:$.:$idx: unterminated string from position $token"
366             if ($idx > $#line);
367             $idx++;
368             fail "$file:$.:$idx: strings not separated"
369             if ($idx <= $#line and $line[$idx] !~ m/\s/);
370         }
371         else
372         {
373             # Skip until end of token indicated by whitespace.
374             while ($idx <= $#line)
375             {
376                 fail "$file:$.:$idx: invalid character"
377                 if ($line[$idx] eq '"');
378
379                 last if ($line[$idx] =~ m/\s/);
380                 $idx++;
381             }
382         }
383
384         push @tokens, substr ($line, $token, $idx - $token);
385
386         # Skip white space between arguments.
387         while ($idx <= $#line and $line[$idx] =~ m/\s/)
388         {
389             $idx++;
390         }
391     }
392
393     return @tokens;
394 }
395
396
397 # We suppress some warnings after first time.
398 %::warn = ();
399
400 # Parse the NSIS line.
401 sub nsis_parse_line
402 {
403     my ($parser, $file, $line) = @_;
404
405     # We first tokenize the line.
406     my @tokens = nsis_tokenize ($file, $line);
407
408     # We handle preprocessing directives here.
409
410     print STDERR "Tokens: " . join (" AND ", @tokens) . "\n"
411     if $::nsis_parser_debug;
412
413     # We have special code dealing with ignored areas.
414     if ($parser->{pre_depth} > $parser->{pre_true})
415     {
416         if ($tokens[0] eq '!ifdef' or $tokens[0] eq '!ifndef')
417         {
418             fail "$file:$.: syntax error" if $#tokens != 1;
419             $parser->{pre_depth}++;
420         }
421         elsif ($tokens[0] eq '!else')
422         {
423             fail "$file:$.: stray !else" if $parser->{pre_depth} == 0;
424
425             if ($parser->{pre_depth} == $parser->{pre_true} + 1)
426             {
427                 $parser->{pre_true}++;
428             }
429         }
430         elsif ($tokens[0] eq '!endif')
431         {
432             fail "$file:$.: syntax error" if $#tokens != 0;
433
434             fail "$file:$.: stray !endif" if $parser->{pre_depth} == 0;
435
436             $parser->{pre_depth}--;
437         }
438         elsif ($tokens[0] eq '!macro')
439         {
440             fail "$file:$.: syntax error" if $#tokens < 1;
441
442             # FIXME: We do not support macros at this point, although
443             # support would not be too hard to add.  Instead, we just
444             # ignore their definition so it does not throw us off.
445
446             print STDERR
447             "$file:$.: warning: ignoring macro $tokens[1]\n"
448             if $::nsis_parser_warn;
449
450             $parser->{pre_depth}++;
451         }
452         elsif ($tokens[0] eq '!macroend')
453         {
454             # FIXME: See !macro.
455             fail "$file:$.: stray !macroend" if $parser->{pre_depth} == 0;
456             $parser->{pre_depth}--;
457         }
458     }
459     else
460     {
461         # This is the parser for areas not ignored.
462         if ($tokens[0] eq '!define')
463         {
464             if ($#tokens == 1)
465             {
466                 # FIXME: Maybe define to 1?
467                 $parser->{pre_symbols}->{$tokens[1]} = '';
468             }
469             elsif ($#tokens == 2)
470             {
471                 $parser->{pre_symbols}->{$tokens[1]} =
472                 nsis_eval ($parser, $file, $tokens[2]);
473             }
474             else
475             {
476                 fail "$file:$.: syntax error";
477             }
478
479         }
480         elsif ($tokens[0] eq '!undef')
481         {
482             fail "$file:$.: syntax error" if $#tokens != 1;
483             delete $parser->{pre_symbols}->{$tokens[1]};
484         }
485         elsif ($tokens[0] eq '!ifdef')
486         {
487             fail "$file:$.: syntax error" if $#tokens != 1;
488
489             if (exists $parser->{pre_symbols}->{$tokens[1]})
490             {
491                 $parser->{pre_true}++;
492             }
493             $parser->{pre_depth}++;
494         }
495         elsif ($tokens[0] eq '!ifndef')
496         {
497             fail "$file:$.: syntax error" if $#tokens != 1;
498
499             if (not exists $parser->{pre_symbols}->{$tokens[1]})
500             {
501                 $parser->{pre_true}++;
502             }
503             $parser->{pre_depth}++;
504         }
505         elsif ($tokens[0] eq '!else')
506         {
507             fail "$file:$.: stray !else" if $parser->{pre_depth} == 0;
508
509             if ($parser->{pre_depth} == $parser->{pre_true})
510             {
511                 $parser->{pre_true}--;
512             }
513             elsif ($parser->{pre_depth} == $parser->{pre_true} + 1)
514             {
515                 $parser->{pre_true}++;
516             }
517         }
518         elsif ($tokens[0] eq '!endif')
519         {
520             fail "$file:$.: syntax error" if $#tokens != 0;
521
522             fail "$file:$.: stray !endif" if $parser->{pre_depth} == 0;
523
524             if ($parser->{pre_depth} == $parser->{pre_true})
525             {
526                 $parser->{pre_true}--;
527             }
528             $parser->{pre_depth}--;
529         }
530         elsif ($tokens[0] eq '!include')
531         {
532             fail "$file:$.: syntax error" if $#tokens != 1;
533
534             if ($tokens[1] eq 'Memento.nsh')
535             {
536                 print STDERR "Skipping $tokens[1]\n"
537                 if $::nsis_parser_debug;
538             }
539             else
540             {       print STDERR "Including $tokens[1]\n"
541                 if $::nsis_parser_debug;
542
543                 my $filename = nsis_eval ($parser, $file, $tokens[1]);
544
545                 # Recursion.
546                 nsis_parse_file ($parser, $filename);
547             }
548         }
549         elsif ($tokens[0] eq '!macro')
550         {
551             fail "$file:$.: syntax error" if $#tokens < 1;
552
553             # FIXME: We do not support macros at this point, although
554             # support would not be too hard to add.  Instead, we just
555             # ignore their definition so it does not throw us off.
556
557             print STDERR
558             "$file:$.: warning: ignoring macro $tokens[1]\n"
559             if $::nsis_parser_warn;
560
561             $parser->{pre_depth}++;
562         }
563         elsif ($tokens[0] eq '!macroend')
564         {
565             # FIXME: See !macro.
566             fail "$file:$.: stray !macroend" if $parser->{pre_depth} == 0;
567             $parser->{pre_depth}--;
568         }
569         elsif ($tokens[0] eq '!cd' or $tokens[0] eq '!addplugindir')
570         {
571             if (not exists $::warn{"directive-$tokens[0]"})
572             {
573                 print STDERR
574                 "$file:$.: warning: ignoring $tokens[0] directive\n"
575                 if $::nsis_parser_warn;
576             }
577             $::warn{"directive-$tokens[0]"}++;
578         }
579         elsif ($tokens[0] eq '!addincludedir')
580         {
581             fail "$file:$.: syntax error" if $#tokens != 1;
582
583             my $dir = nsis_eval ($parser, $file, $tokens[1]);
584
585             unshift @{$parser->{includedirs}}, $dir;
586         }
587         elsif ($tokens[0] =~ m/^\!/ and $tokens[0] ne '!insertmacro')
588         {
589             # Note: It is essential that some !insertmacro invocations are
590             # not expanded, namely those of SelectSection and UnselectSection,
591             # which are used to track dependencies in Gpg4win.
592
593             fail "$file:$.: compiler directive $tokens[0] not implemented";
594         }
595         else
596         {
597             # Main processing routine.  This is specific to the backend
598             # and probably package.
599             gpg4win_nsis_stubs ($parser, $file, @tokens);
600         }
601     }
602 }
603
604
605 # Parse the NSIS file.
606 sub nsis_parse_file
607 {
608     my ($parser, $file) = @_;
609     my $handle;
610
611     if ($file eq '-')
612     {
613         $. = 0;
614         $handle = *STDIN;
615     }
616     else
617     {
618         if (not -e $file and 1)
619         {
620             # Search for include file.  Note: We do not change
621             # directories, but that is OK for us.  Also, we want to
622             # avoid the system header files, as we don't control what
623             # constructs they use, and in fact we want to treat their
624             # macros and functions as atoms.
625
626             my @includedirs = @{$parser->{includedirs}};
627             my $dir;
628
629             foreach $dir (@includedirs)
630             {
631                 if (-e $dir . '/' . $file)
632                 {
633                     $file = $dir . '/' . $file;
634                     last;
635                 }
636             }
637         }
638
639         if (not open ($handle, "<$file"))
640         {
641             print STDERR "$file:$.: warning: "
642             . "can not open include file $file: $!\n"
643             if $::nsis_parser_warn;
644             return;
645         }
646     }
647
648     my $incomment = 0;
649     while (defined nsis_get_line ($handle))
650     {
651         $.++ if ($file eq '-');
652
653         # Check for our block comment
654         if ($_ =~ m/^# BEGIN MSI IGNORE.*/)
655         {
656             $incomment = 1;
657         }
658         elsif ($_ =~ m/^# END MSI IGNORE.*/)
659         {
660             $incomment = 0;
661         }
662         next if $incomment;
663
664         # Skip comment lines.
665         next if $_ =~ m/^#/;
666
667         # Skip empty lines.
668         next if $_ =~ m/^$/;
669
670
671         nsis_parse_line ($parser, $file, $_);
672     }
673
674     if ($incomment) {
675         fail "$file:$.: error: Missing # END MSI IGNORE marker.\n";
676     }
677
678
679     close $handle if ($file ne '-');
680 }
681
682 \f
683 # The Gpg4win stubs for the MSI backend to the NSIS converter.
684
685 # Gpg4win specific state in $parser:
686 # pkg: the current package (a hash reference), corresponds to certain sections.
687 # pkgs: a hash ref of all packages encountered indexed by their frobbed name.
688 # pkg_list: the order of packages (as frobbed names).
689 # state: specifies a state for special parsing of certain parts.
690 # dep_name: the current package for which we list dependencies (- for none)
691
692 # Ignored packages:
693 %::ignored_pkgs = ("gpa", "gtk_", "glib", "expat", "gdk_pixbuf",
694                    "cairo", "fontconfig", "atk", "zlib", "libpng",
695                    "freetype", "libffi", "pango");
696
697 sub gpg4win_nsis_stubs
698 {
699     my ($parser, $file, $command, @args) = @_;
700
701     $parser->{state} = "" if not defined $parser->{state};
702
703     if ($parser->{state} =~ m/^ignore-until-(.*)$/)
704     {
705         undef $parser->{state} if ($command eq $1);
706     }
707
708     # Section support.
709     #
710     # We parse SetOutPath and File directives in sections.
711     # Everything else is ignored.
712
713     elsif ($parser->{state} eq ''
714             and ($command eq 'Section' or $command eq '${MementoSection}'
715                 or $command eq '${MementoUnselectedSection}'))
716     {
717         my $idx = 0;
718         # Default install level for MSI is 3.
719         my $level = $::nsis_level_default;
720         my $hidden = 0;
721
722         if ($command eq '${MementoUnselectedSection}')
723         {
724             # Default install level for MSI is 3.
725             $level = $::nsis_level_optional;
726         }
727
728         # Check for options first.
729         return if ($idx > $#args);
730         if ($args[$idx] eq '/o')
731         {
732             # Default install level for MSI is 3.
733             $level = $::nsis_level_optional;
734             $idx++;
735         }
736
737         return if ($idx > $#args);
738
739         my $title = nsis_eval ($parser, $file, $args[$idx++]);
740
741         # Check for hidden flag.
742         if (substr ($title, 0, 1) eq '-')
743         {
744             # Hidden packages are dependency tracked and never
745             # installed by default unless required.
746             $level = $::nsis_level_hidden;
747             $hidden = 1;
748             substr ($title, 0, 1) = '';
749         }
750
751         # We only pay attention to special sections and those which
752         # have a section index defined.
753         if ($title eq 'startmenu')
754         {
755             # The special startmenu section contains all our shortcuts.\
756             $parser->{state} = 'section-startmenu';
757             return;
758         }
759         elsif ($idx > $#args)
760         {
761             return;
762         }
763
764         # Finally we can get the frobbed name of the package.
765         my $name = $args[$idx++];
766         $name =~ s/^SEC_//;
767
768         my $pkg = \%{$parser->{pkgs}->{$name}};
769
770         # Check for ignored packages
771         foreach my $ignored (%::ignored_pkgs)
772         {
773             if ($name eq $ignored)
774             {
775                 print STDERR "Ignoring package: " . $name . "\n"
776                 if $::nsis_parser_debug;
777                 return;
778             }
779         }
780
781         $pkg->{name} = $name;
782         # Replace - in names to avoid errors with identifies
783         $pkg->{name} =~ s/-/_/g;
784         $pkg->{title} = $title;
785         $pkg->{level} = $level;
786         $pkg->{hidden} = $hidden;
787         $pkg->{features} = '';
788
789         # Remember the order of sections included.
790         push @{$parser->{pkg_list}}, $name;
791
792         $parser->{pkg} = $pkg;
793         $parser->{state} = 'in-section';
794     }
795     elsif ($parser->{state} eq 'in-section')
796     {
797         if ($command eq 'SectionEnd' or $command eq '${MementoSectionEnd}')
798         {
799             delete $parser->{pkg};
800             undef $parser->{state};
801         }
802         elsif ($command eq 'SetOutPath')
803         {
804             fail "$file:$.: syntax error" if ($#args != 0);
805
806             my $outpath = $args[0];
807             #       if (not $outpath =~ s/^"\$INSTDIR\\?(.*)"$/$1/)
808             if ($outpath =~ m/^"\$INSTDIR\\?(.*)"$/)
809             {
810                 $parser->{outpath} = $1;
811             }
812             elsif ($outpath =~ m/^"\$APPDATA\\?(.*)"$/)
813             {
814                 $parser->{outpath} = "%CommonAppDataFolder%\\" . $1;
815             }
816             elsif ($outpath =~ m/^"\$TEMP\\?(.*)"$/)
817             {
818                 $parser->{outpath} = "%TEMP%\\" . $1;
819             }
820             elsif ($outpath =~ m/^"\$PLUGINSDIR\\?(.*)"$/)
821             {
822                 $parser->{outpath} = "REMOVE_ME\\" . $1;
823             }
824             else
825             {
826                 fail "$file:$.: unsupported out path: $args[0]";
827             }
828         }
829         elsif ($command eq 'File')
830         {
831             my $idx = 0;
832             my $target;
833
834             fail "$file:$.: not supported" if ($#args < 0 || $#args > 1);
835
836             if ($#args == 1)
837             {
838                 if ($args[0] eq '/nonfatal')
839                 {
840                     print STDERR "$file:$.: warning: skipping non-fatal file $args[1]\n"
841                     if $::nsis_parser_warn;
842                     return;
843                 }
844
845                 $target = $args[0];
846                 if (not $target =~ s,^/oname=(.*)$,$1,)
847                 {
848                     fail "$file:$.: syntax error";
849                 }
850
851                 # Temp files are due to overwrite attempts, which are
852                 # handled automatically by the Windows Installer.  Ignore
853                 # them here.
854                 return if $target =~ m/\.tmp$/;
855                 $idx++;
856             }
857
858             my $source = nsis_eval ($parser, $file, $args[$idx]);
859             if (not defined $target)
860             {
861                 $target = $source;
862                 $target =~ s,^.*/([^/\\]+)$,$1,;
863             }
864
865             push @{$parser->{pkg}->{files}}, { source => $source,
866                 dir => $parser->{outpath},
867                 target => $target };
868         }
869         elsif ($command eq 'WriteRegStr')
870         {
871             fail "$file:$.: not supported" if ($#args != 3);
872
873             my $root = $args[0];
874
875             my $key = $args[1];
876             $key =~ s/^"(.*)"$/$1/;
877
878             my $name = $args[2];
879             $name =~ s/^"(.*)"$/$1/;
880
881             my $value = $args[3];
882             $value =~ s/^"(.*)"$/$1/;
883             $value =~ s/\$INSTDIR\\?/\[INSTDIR\]/g;
884
885             push (@{$parser->{pkg}->{registry}},
886                 { root => $root, key => $key, name => $name,
887                     value => $value, type => 'string' });
888         }
889     }
890
891     # Start menu shortcuts support.
892
893     elsif ($parser->{state} eq 'section-startmenu')
894     {
895         if ($command eq 'SectionEnd' or $command eq '${MementoSectionEnd}')
896         {
897             undef $parser->{state};
898         }
899         elsif ($command eq 'CreateShortCut')
900         {
901             fail "$file:$.: not supported" if ($#args != 7);
902
903             # The link may contains a translatable string.
904             my $link = $args[0];
905
906             # We filter for startmenu shortcuts, as the others are
907             # just more of the same.  Equivalently, we could filter
908             # for a block between two labels.
909             return if ($link !~ m/STARTMENU_FOLDER/);
910
911             # Take the base name of the link.
912             # FIXME: We want the manuals in a subdirectory.
913             $link =~ s/^.*\\([^\\]*)\"$/$1/;
914             $link =~ s/\.lnk$//;
915
916             my $target = nsis_eval ($parser, $file, $args[1]);
917             $target =~ s/^\$INSTDIR\\//;
918
919             my $icon = $args[3];
920             $icon =~ s/^"(.*)"$/$1/;
921             $icon =~ s/^\$INSTDIR\\/[INSTDIR]/;
922             $icon = nsis_eval ($parser, $file, $icon);
923
924             my $icon_idx = nsis_eval ($parser, $file, $args[4]);
925             fail "$file:$.: not supported" if ($icon_idx ne '');
926
927             # The description contains a translatable string.
928             my $description = $args[7];
929
930             $parser->{shortcuts}->{$target} = { link => $link,
931                 target => $target,
932                 icon => $icon,
933                 description => $description };
934         }
935     }
936
937     # LangString support.
938     #
939     # LangString directives must be stated at the top-level of the file.
940
941     elsif ($parser->{state} eq '' and $command eq 'LangString')
942     {
943         fail "$file:$.: syntax error" if ($#args != 2);
944
945         my $lang = $args[1];
946         $lang =~ s/^\$\{LANG_(\w*)\}$/$1/;
947         if ($lang eq 'ENGLISH')
948         {
949             $lang = 'en';
950         }
951         elsif ($lang eq 'GERMAN')
952         {
953             $lang = 'de';
954         }
955         elsif ($lang eq 'ARABIC')
956         {
957             $lang = 'ar';
958         }
959         elsif ($lang eq 'SPANISH')
960         {
961             $lang = 'es';
962         }
963         elsif ($lang eq 'FRENCH')
964         {
965             $lang = 'fr';
966         }
967         elsif ($lang eq 'RUSSIAN')
968         {
969             $lang = 'ru';
970         }
971         elsif ($lang eq 'PORTUGUESE')
972         {
973             $lang = 'pt';
974         }
975         elsif ($lang eq 'CZECH')
976         {
977             $lang = 'cz';
978         }
979         elsif ($lang eq 'ITALIAN')
980         {
981             $lang = 'it';
982         }
983         elsif ($lang eq 'SIMPCHINESE')
984         {
985             $lang = 'zh_CN';
986         }
987         elsif ($lang eq 'TRADCHINESE')
988         {
989             $lang = 'zh_TW';
990         }
991         elsif ($lang eq 'NORWEGIAN')
992         {
993             $lang = 'no';
994         }
995         elsif ($lang eq 'DUTCH')
996         {
997             $lang = 'nl';
998         }
999         else
1000         {
1001             fail "$file:$.: unsupported language ID $args[1]";
1002         }
1003         $parser->{po}->{$lang}->{$args[0]} = $args[2];
1004     }
1005
1006     # Function support.
1007     #
1008     # Most functions are ignored.  Some are of special interest and
1009     # are parsed separately.
1010
1011     elsif ($parser->{state} eq '' and $command eq 'Function')
1012     {
1013         fail "$file:$.: syntax error" if ($#args != 0);
1014
1015         if ($args[0] eq 'CalcDepends')
1016         {
1017             $parser->{state} = 'function-calc-depends';
1018         }
1019         elsif ($args[0] eq 'CalcDefaults')
1020         {
1021             $parser->{state} = 'function-calc-defaults';
1022         }
1023         else
1024         {
1025             # Functions we do not find interesting are skipped.
1026             print STDERR
1027             "$file:$.: warning: ignoring function $args[0]\n"
1028             if $::nsis_parser_warn;
1029             delete $parser->{dep_name};
1030             $parser->{state} = 'ignore-until-FunctionEnd';
1031         }
1032     }
1033
1034     # Function calc-depends.
1035     #
1036     # This function gathers information about dependencies between
1037     # features.  Features are identified by their frobbed names.  The
1038     # format is as such: First, a couple of UnselectSection macros,
1039     # one for each dependency.  Then SelectSection invocations for all
1040     # packages which should always be installed (mandatory), followed
1041     # by one block for each feature, consisting of a label "have_FOO:"
1042     # where FOO is the frobbed package name (in lowercase, usually),
1043     # followed by SelectSection invocations, one for each dependency,
1044     # and finally a "skip_FOO:" label to finish the block.
1045     #
1046     # The order of these statements and blocks must be so that a single pass
1047     # through the list is sufficient to resolve all dependencies, that means
1048     # in pre-fix order.
1049
1050     elsif ($parser->{state} eq 'function-calc-depends')
1051     {
1052         if ($command eq 'FunctionEnd')
1053         {
1054             undef $parser->{state};
1055         }
1056         elsif ($command =~ m/^have_(.*):$/)
1057         {
1058             $parser->{dep_name} = $1;
1059             $parser->{pkgs}->{$1}->{deps} = {};
1060         }
1061         elsif ($command eq '!insertmacro')
1062         {
1063             fail "$file:$.: syntax error" if $#args < 0;
1064             if ($args[0] eq 'SelectSection')
1065             {
1066                 fail "$file:$.: syntax error" if $#args != 1;
1067                 my $name = $args[1];
1068                 $name =~ s/^\$\{SEC_(.*)\}$/$1/;
1069
1070                 if (not exists $parser->{dep_name})
1071                 {
1072                     # A stray SelectSection chooses defaults.
1073                     $parser->{pkgs}->{$name}->{features} .=
1074                     " Absent='disallow'";
1075                 }
1076                 else
1077                 {
1078                     my $dep_name = $parser->{dep_name};
1079                     print STDERR "DEP: Add " . $name . " as a dependency for " .
1080                     $dep_name . "\n" if $::nsis_parser_debug;
1081
1082                     # Add $name as a dependency for $dep_name.
1083                     $parser->{pkgs}->{$dep_name}->{deps}->{$name} = 1;
1084                 }
1085             }
1086         }
1087         elsif ($command =~ m/^skip_(.*):$/)
1088         {
1089             fail "$file:$.: stray skip_FOO label"
1090             if not exists $parser->{dep_name};
1091
1092             my $dep_name = $parser->{dep_name};
1093             my $dep_pkg = $parser->{pkgs}->{$dep_name};
1094
1095             # We resolve indirect dependencies right now.  This works
1096             # because dependencies are required to be listed in
1097             # pre-fix order.
1098
1099             foreach my $name (keys %{$parser->{pkgs}})
1100             {
1101                 my $pkg = $parser->{pkgs}->{$name};
1102
1103                 # Check if $dep_name is a dependency for $name.
1104                 if (exists $pkg->{deps}->{$dep_name})
1105                 {
1106                     # Add all dependencies of $dep_name to $name.
1107                     foreach my $dep (keys %{$dep_pkg->{deps}})
1108                     {
1109                         $pkg->{deps}->{$dep} = $pkg->{deps}->{$dep_name} + 1
1110                         if (not defined $pkg->{deps}->{$dep});
1111                     }
1112                 }
1113             }
1114             delete $parser->{dep_name};
1115         }
1116     }
1117
1118     # Function calc-depends.
1119     #
1120     # Format:
1121     # g4wihelp::config_fetch_bool "inst_FOO"
1122
1123     elsif ($parser->{state} eq 'function-calc-defaults')
1124     {
1125         if ($command eq 'FunctionEnd')
1126         {
1127             undef $parser->{state};
1128         }
1129         elsif ($command eq 'g4wihelp::config_fetch_bool')
1130         {
1131             fail "$file:$.: syntax error" if $#args != 0;
1132
1133             if ($args[0] !~ m/^"inst_(.*)"$/)
1134             {
1135                 fail "$file:$.: syntax error";
1136             }
1137
1138             $parser->{pkgs}->{$1}->{ini_inst} = 1;
1139         }
1140     }
1141 }
1142
1143 \f
1144 # MSI generator.
1145
1146 # Simple indentation tracking, for pretty printing.
1147 $::level = 0;
1148
1149
1150 sub dump_all
1151 {
1152     my ($parser) = @_;
1153
1154     my $pkgname;
1155     # A running count for files within each feature.
1156     my $fileidx;
1157     # A running count for registry settings within each feature.
1158     my $regidx;
1159     # A running count for directories throughout the whole file.
1160     my $diridx = 0;
1161     # The current directory.
1162     my $cdir = '';
1163
1164     foreach $pkgname (@{$parser->{pkg_list}})
1165     {
1166         my $pkg = $parser->{pkgs}->{$pkgname};
1167
1168         $fileidx = 0;
1169         foreach my $file (@{$pkg->{files}})
1170         {
1171             if ($cdir ne $file->{dir})
1172             {
1173                 # We need to change the directory.  We weed out empty
1174                 # path elements, which also takes care of leading slashes.
1175                 my @cdir = grep (!/^$/, split (/\\/, $cdir));
1176                 my @ndir = grep (!/^$/, split (/\\/, $file->{dir}));
1177                 my $min;
1178                 my $i;
1179                 $min = $#cdir;
1180                 $min = $#ndir if ($#ndir < $min);
1181                 for ($i = 0; $i <= $min; $i++)
1182                 {
1183                     last if ($cdir[$i] ne $ndir[$i])
1184                 }
1185                 my $j;
1186                 for ($j = $i; $j <= $#cdir; $j++)
1187                 {
1188                     $::level -= 2;
1189                     print ' ' x $::level
1190                     . "</Directory>\n";
1191                 }
1192                 for ($j = $i; $j <= $#ndir; $j++)
1193                 {
1194                     print ' ' x $::level
1195                     . "<Directory Id='d_$diridx' Name='$ndir[$j]'>\n";
1196                     $diridx++;
1197                     $::level += 2;
1198                 }
1199                 $cdir = $file->{dir};
1200             }
1201
1202             my $targetfull;
1203             if ($file->{dir} ne '')
1204             {
1205                 $targetfull = $file->{dir} . '\\' . $file->{target};
1206             }
1207             else
1208             {
1209                 $targetfull = $file->{target};
1210             }
1211
1212             print ' ' x $::level
1213             . "<Component Id='c_$pkg->{name}_$fileidx' Guid='"
1214             . get_guid ($targetfull) . "'>\n";
1215             my $sourcefull;
1216             $sourcefull = $file->{source};
1217             $sourcefull =~ s/playground\/install-ex/\$(var.InstDirEx)/;
1218             $sourcefull =~ s/playground\/install/\$(var.InstDir)/;
1219             $sourcefull =~ s/\.\//\$(var.SrcDir)\//;
1220             $sourcefull =~ s/\//\\/g;
1221             print ' ' x $::level
1222             . "  <File Id='f_$pkg->{name}_$fileidx' Name='"
1223             . $file->{target} ."' KeyPath='yes'" . " Source='" .
1224             $sourcefull . "'>\n";
1225             # Does not help to avoid the warnings: DefaultLanguage='1033'.
1226
1227             # EXCEPTIONS:
1228             if ($targetfull eq 'gpgex.dll')
1229             {
1230                 print ' ' x $::level
1231                 . "    <Class Id='{CCD955E4-5C16-4A33-AFDA-A8947A94946B}' "
1232                 . "Context='InprocServer32' Description='GpgEX' "
1233                 . "ThreadingModel='apartment'/>\n";
1234             }
1235             # Create shortcuts.
1236             if (defined $parser->{shortcuts}->{$targetfull})
1237             {
1238                 my $shortcut = $parser->{shortcuts}->{$targetfull};
1239                 my $extra = '';
1240
1241                 if (exists $shortcut->{description})
1242                 {
1243                     my $desc = nsis_translate ($parser, '',
1244                         $shortcut->{description});
1245                     $extra .= " Description='$desc'";
1246                 }
1247                 # FIXME: WiX wants the icon to be known at compile time, so it needs a
1248                 # source file, not a target file name.
1249                 #       if ($shortcut->{icon} ne '')
1250                 #       {
1251                 #           $extra .= " Icon='sm_$pkg->{name}_${fileidx}_icon'";
1252                 #       }
1253
1254                 # FIXME: Note that the link name should better not
1255                 # change, or it is not correctly replaced on updates.
1256                 my $link = nsis_translate ($parser, '', $shortcut->{link});
1257                 print ' ' x $::level
1258                 . "    <Shortcut Id='sm_$pkg->{name}_$fileidx' "
1259                 . "Directory='ProgramMenuDir' Name='$link'"
1260                 . $extra;
1261
1262                 #       if ($shortcut->{icon} eq '')
1263                 #       {
1264                 print "/>\n";
1265                 #       }
1266                 #       else
1267                 #       {
1268                 #           print ">\n";
1269                 #           print ' ' x $::level
1270                 #           . "      <Icon Id='sm_$pkg->{name}_${fileidx}_icon' "
1271                 #           . "SourceFile='$shortcut->{icon}'/>\n";
1272                 #           print ' ' x $::level
1273                 #           . "    </Shortcut>\n";
1274                 #       }
1275
1276                 # Can't make these optional, so we don't do this.
1277                 #       print ' ' x $::level
1278                 #                   . "    <Shortcut Id='dt_$pkg->{name}_$fileidx' "
1279                 #           . "Directory='DesktopFolder' Name='$file->{target}'/>\n";
1280             }
1281
1282             print ' ' x $::level
1283             . "  </File>\n";
1284
1285             if (defined $parser->{shortcuts}->{$targetfull})
1286             {
1287                 # http://www.mail-archive.com/wix-users@lists.sourceforge.net/msg02746.html
1288                 # -sice:ICE64
1289                 print ' ' x $::level
1290                 . "  <RemoveFolder Id='rsm_$pkg->{name}_$fileidx' "
1291                 . "Directory='ProgramMenuDir' On='uninstall'/>\n";
1292             }
1293
1294             # EXCEPTIONS:
1295             # We use $targetfull because there is also a gpg.exe in pub\.
1296             if ($targetfull eq 'bin\\gpgol.dll')
1297             {
1298                 print <<EOF;
1299                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Classes\\CLSID\\{42d30988-1a3a-11da-c687-000d6080e735}\\InprocServer32" Value="[#f_gpgol_0]" Type="string" Action="write" />
1300                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Classes\\CLSID\\{42d30988-1a3a-11da-c687-000d6080e735}\\InprocServer32" Name="ThreadingModel" Value="Both" Type="string" Action="write" />
1301                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Classes\\CLSID\\{42d30988-1a3a-11da-c687-000d6080e735}\\ProgID" Value="GNU.GpgOL" Type="string" Action="write" />
1302                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Classes\\CLSID\\{42d30988-1a3a-11da-c687-000d6080e735}" Value="GpgOL - The GnuPG Outlook Plugin" Type="string" Action="write" />
1303                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Classes\\GNU.GpgOL\\CLSID" Value="{42d30988-1a3a-11da-c687-000d6080e735}" Type="string" Action="write" />
1304                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Classes\\GNU.GpgOL" Value="GpgOL - The GnuPG Outlook Plugin" Type="string" Action="write" />
1305                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\GNU\\GpgOL" Value="" Type="string" Action="write" />
1306                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Microsoft\\Office\\Outlook\\Addins\\GNU.GpgOL" Name="LoadBehavior" Value="3" Type="integer" Action="write" />
1307                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Microsoft\\Office\\Outlook\\Addins\\GNU.GpgOL" Name="CommandLineSafe" Value="0" Type="integer" Action="write" />
1308                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Microsoft\\Office\\Outlook\\Addins\\GNU.GpgOL" Name="FriendlyName" Value="GpgOL - The GnuPG Outlook Plugin" Type="string" Action="write" />
1309                 <RegistryValue Root="HKMU" KeyPath='yes' Key="Software\\Microsoft\\Office\\Outlook\\Addins\\GNU.GpgOL" Name="Description" Value="Cryptography for Outlook" Type="string" Action="write" />
1310 EOF
1311             }
1312             elsif ($targetfull eq 'gpgex.dll')
1313             {
1314                 print ' ' x $::level
1315                 . "  <ProgId Id='*'/>\n";
1316                 print ' ' x $::level
1317                 . "  <ProgId Id='Directory'/>\n";
1318                 print ' ' x $::level
1319                 . "  <RegistryValue Root='HKCR' "
1320                 . "Key='*\\ShellEx\\ContextMenuHandlers\\GpgEX' "
1321                 . "Value='{CCD955E4-5C16-4A33-AFDA-A8947A94946B}' "
1322                 . "Type='string' Action='write'/>\n";
1323                 print ' ' x $::level
1324                 . "  <RegistryValue Root='HKCR' "
1325                 . "Key='Directory\\ShellEx\\ContextMenuHandlers\\GpgEX' "
1326                 . "Value='{CCD955E4-5C16-4A33-AFDA-A8947A94946B}' "
1327                 . "Type='string' Action='write'/>\n";
1328             }
1329             elsif ($targetfull eq 'gpgee.dll')
1330             {
1331                 print STDERR "ERR: run heat.exe on gpgee.dll and add info\n";
1332                 exit 1;
1333             }
1334
1335             print ' ' x $::level
1336             . "</Component>\n";
1337             $fileidx++;
1338         }
1339
1340         $regidx = 0;
1341         foreach my $reg (@{$pkg->{registry}})
1342         {
1343             my $target;
1344             my $root;
1345
1346             if ($reg->{root} eq 'SHCTX')
1347             {
1348                 $root = 'HKMU';
1349             }
1350             else
1351             {
1352                 $root = $reg->{root};
1353             }
1354
1355             my $localValue;
1356
1357             # Some values need to be translated, like descriptions.
1358             if ($reg->{value} =~ m/^\$/)
1359             {
1360                 $localValue = nsis_translate ($parser, '', $reg->{value});
1361             }
1362             else
1363             {
1364                 $localValue = $reg->{value};
1365             }
1366
1367             $target = '/REGISTRY/' . $reg->{root} . '/' . $reg->{key}
1368             . '/' . $reg->{name};
1369
1370             my $namepart="";
1371             if ($reg->{name} ne "")
1372             {
1373                 $namepart = "Name='$reg->{name}' ";
1374             }
1375
1376             print ' ' x $::level
1377             . "<Component Id='c_$pkg->{name}_r_$regidx' Guid='"
1378             . get_guid ($target) . "' KeyPath='yes'>\n";
1379             print ' ' x $::level
1380             . "  <RegistryValue Id='r_$pkg->{name}_$regidx' Root='"
1381             . $root . "' Key='" . $reg->{key} . "' " . $namepart
1382             . " Action='write' Type='" . $reg->{type}
1383             . "' Value='" . $localValue . "'/>\n";
1384             print ' ' x $::level
1385             . "</Component>\n";
1386             $regidx++;
1387         }
1388     }
1389
1390     my @cdir = grep (!/^$/, split (/\\/, $cdir));
1391     my $j;
1392     for ($j = 0; $j <= $#cdir; $j++)
1393     {
1394         $::level -= 2;
1395         print ' ' x $::level
1396         . "</Directory>\n";
1397     }
1398 }
1399
1400
1401 sub dump_meat
1402 {
1403     my ($pkg) = @_;
1404     my $fileidx;
1405     my $regidx;
1406
1407     $fileidx = 0;
1408     foreach my $file (@{$pkg->{files}})
1409     {
1410         print ' ' x $::level
1411         . "  <ComponentRef Id='c_$pkg->{name}_$fileidx'/>\n";
1412         $fileidx++;
1413     }
1414     $regidx = 0;
1415     foreach my $reg (@{$pkg->{registry}})
1416     {
1417         print ' ' x $::level
1418         . "  <ComponentRef Id='c_$pkg->{name}_r_$regidx'/>\n";
1419         $regidx++;
1420     }
1421 }
1422
1423
1424 sub dump_all2
1425 {
1426     my ($parser) = @_;
1427
1428     my $pkgname;
1429
1430     foreach $pkgname (@{$parser->{pkg_list}})
1431     {
1432         my $pkg = $parser->{pkgs}->{$pkgname};
1433         my $features;
1434
1435         next if $pkg->{hidden};
1436
1437         $features = $pkg->{features};
1438         #   $features .= " Display='hidden'" if $pkg->{hidden};
1439         $features .= " Description='$pkg->{description}'"
1440         if $pkg->{description};
1441
1442         my $title = nsis_translate ($parser, '', $pkg->{title});
1443
1444         print ' ' x $::level
1445         . "<Feature Id='p_$pkg->{name}' Level='$pkg->{level}' "
1446         . "Title='$title'" . $features . ">\n";
1447         if ($pkg->{ini_inst})
1448         {
1449             my $uc_pkgname = uc ($pkgname);
1450
1451             print ' ' x $::level
1452             . "<Condition Level='$::nsis_level_default'>"
1453             . "INST_$uc_pkgname = \"true\"</Condition>\n";
1454             print ' ' x $::level
1455             . "<Condition Level='$::nsis_level_optional'>"
1456             . "INST_$uc_pkgname = \"false\"</Condition>\n";
1457         }
1458
1459         dump_meat ($pkg);
1460
1461         foreach my $dep (keys %{$pkg->{deps}})
1462         {
1463             $dep =~ s/-/_/g;
1464             my $deppkg = $parser->{pkgs}->{$dep};
1465
1466             # We use Level=1 because with InstallDefault followParent
1467             # the Level seems to specify some sort of minimum install
1468             # level or something (FIXME: confirm this).
1469             print ' ' x $::level
1470             . "  <Feature Id='p_$pkg->{name}_$dep' "
1471             . "Title='p_$pkg->{name}_$dep' "
1472             . "Level='1' Display='hidden' "
1473             . "InstallDefault='followParent'>\n";
1474             $::level += 2;
1475             dump_meat ($deppkg);
1476             $::level -= 2;
1477             print ' ' x $::level
1478             . "  </Feature>\n";
1479         }
1480         print ' ' x $::level
1481         . "</Feature>\n";
1482     }
1483 }
1484
1485 \f
1486 # Just so that it is defined.
1487 $. = 0;
1488
1489 my %parser = ( pre_depth => 0, pre_true => 0 );
1490 my $parser = \%parser;
1491
1492 fetch_guids ();
1493
1494 while ($#ARGV >= 0 and $ARGV[0] =~ m/^-/)
1495 {
1496     my $opt = shift @ARGV;
1497     if ($opt =~ m/^--guids$/)
1498     {
1499         $::guid_file = shift @ARGV;
1500     }
1501     elsif ($opt =~ m/^--manifest$/)
1502     {
1503         $::files_file = shift @ARGV;
1504     }
1505     elsif ($opt =~ m/^-D([^=]*)=(.*)$/)
1506     {
1507         $parser->{pre_symbols}->{$1} = $2;
1508     }
1509     elsif ($opt =~ m/^-L(.*)$/)
1510     {
1511         $::lang = $1;
1512         # Test if it is supported.
1513         lang_to_lcid ($::lang);
1514     }
1515     elsif ($opt eq '--usage')
1516     {
1517         print STDERR "Usage: $0 [-DNAME=VALUE...] NSIFILE\n";
1518         print STDERR "Use --help or -h for more information.\n";
1519         exit 1;
1520     }
1521     elsif ($opt eq '-h' or $opt eq '--help')
1522     {
1523         print STDERR "Usage: $0 [-DNAME=VALUE...] NSIFILE\n";
1524         print STDERR "Convert the .nsi file NSIFILE to a WiX source file.\n";
1525         print STDERR "Options:\n";
1526         print STDERR "       --guids NAME     Save GUIDs into file NAME (default: $::guid_file)\n";
1527         print STDERR "       --manifest NAME  Save included files into file NAME (default: $::files_file)\n";
1528         print STDERR "       -DNAME=VALUE     Define preprocessor symbol NAME to VALUE\n";
1529         print STDERR "       -LLANG           Build installer for language LANG (default: $::lang)\n";
1530         print STDERR "\n";
1531         print STDERR "       -h|--help        Print this help and exit\n";
1532         exit 0;
1533     }
1534     else
1535     {
1536         print STDERR "$0: unknown option $opt\n";
1537         print STDERR "Usage: $0 [-DNAME=VALUE...] NSIFILE\n";
1538         print STDERR "Use --help or -h for more information.\n";
1539         exit 1;
1540     }
1541 }
1542
1543
1544 if ($#ARGV < 0)
1545 {
1546     nsis_parse_file ($parser, '-');
1547 }
1548 else
1549 {
1550     nsis_parse_file ($parser, $ARGV[0]);
1551 }
1552
1553 # Add exceptions.
1554 # ===============
1555
1556 $parser->{pkgs}->{gnupg}->{deps}->{gpg4win} = 1;
1557
1558 # For debugging:
1559 # use Data::Dumper;
1560 # print Dumper ($parser);
1561 # exit;
1562
1563 # Dump the gathered information.
1564 # ==============================
1565
1566 my $BUILD_FILEVERSION = nsis_fetch ($parser, '_BUILD_FILEVERSION');
1567
1568 my $product_id = get_guid ("/PRODUCT/$BUILD_FILEVERSION");
1569 my $upgrade_code = get_guid ("/UPGRADE/1");
1570
1571 my $INSTALL_DIR = nsis_fetch ($parser, 'INSTALL_DIR');
1572
1573 my $lcid = lang_to_lcid ($::lang);
1574
1575 # Replacement regex for components:
1576 # :'<,'>s/.*Component: \(.*\) does not.*/      <ComponentRef Id=\1 \/>/
1577
1578 print <<EOF;
1579 <?xml version='1.0'?>
1580 <Wix xmlns='http://schemas.microsoft.com/wix/2006/wi'>
1581   <!-- The general product setup -->
1582   <Product Name='Gpg4win Enterprise'
1583            Id='$product_id'
1584            UpgradeCode='$upgrade_code'
1585            Language='$lcid'
1586            Codepage='1252'
1587            Version='$BUILD_FILEVERSION'
1588            Manufacturer='GnuPG.com'>
1589     <Package Description='Gpg4win Enterprise Installer'
1590              Comments='http://www.gnupg.com/'
1591              Compressed='yes'
1592              InstallerVersion='200'
1593              Manufacturer='GnuPG.com'
1594              Languages='1033' SummaryCodepage='1252'/>
1595
1596     <Condition Message="At least Windows 7 or Server 2008 R2 required.">
1597         <![CDATA[Installed OR (VersionNT >= 601)]]>
1598     </Condition>
1599
1600     <InstallExecuteSequence>
1601       <RemoveExistingProducts After='InstallFinalize' />
1602     </InstallExecuteSequence>
1603
1604     <Upgrade Id='$upgrade_code'>
1605       <UpgradeVersion Property='UPGRADEPROP'
1606                       IncludeMaximum='no'
1607                       Maximum='$BUILD_FILEVERSION'/>
1608     </Upgrade>
1609
1610     <!-- Set up Properties -->
1611     <MediaTemplate EmbedCab="yes" />
1612     <!-- 2 is like highest available in msi -->
1613     <Property Id="ALLUSERS" Value="2" />
1614
1615     <Property Id="INSTDIR">
1616       <RegistrySearch Id='gpg4win_instdir_registry' Type='raw'
1617        Root='HKLM' Key='Software\\Gpg4win' Name='Install Directory'/>
1618       <IniFileSearch Id='gpg4win_instdir_ini' Type='raw'
1619        Name='gpg4win.ini' Section='gpg4win' Key='instdir'/>
1620     </Property>
1621
1622     <Feature Id="Feature_GnuPG"
1623          Title="GnuPG"
1624          Level="1"
1625          Absent='disallow'>
1626       <ComponentGroupRef Id="CMP_GnuPG" />
1627
1628       <!-- Hardcode some components that always should be installed -->
1629
1630       <!-- List comes from ICE21 and was transformed by see: comment above -->
1631       <ComponentRef Id='c_gpg4win_0' />
1632       <ComponentRef Id='c_gpg4win_1' />
1633       <ComponentRef Id='c_gpg4win_2' />
1634       <ComponentRef Id='c_gpg4win_3' />
1635       <ComponentRef Id='c_gpg4win_4' />
1636       <ComponentRef Id='c_gpg4win_5' />
1637       <ComponentRef Id='c_gpg4win_6' />
1638       <ComponentRef Id='c_gpg4win_7' />
1639       <ComponentRef Id='c_gpg4win_8' />
1640       <ComponentRef Id='c_gpg4win_9' />
1641       <ComponentRef Id='c_gpg4win_10' />
1642       <ComponentRef Id='c_gpg4win_11' />
1643       <ComponentRef Id='c_pinentry_0' />
1644       <ComponentRef Id='c_pinentry_1' />
1645       <ComponentRef Id='c_scute_0' />
1646       <ComponentRef Id='c_paperkey_0' />
1647       <ComponentRef Id='c_paperkey_1' />
1648
1649     </Feature>
1650 EOF
1651
1652 foreach my $pkgname (@{$parser->{pkg_list}})
1653 {
1654     if (exists $parser->{pkgs}->{$pkgname}->{ini_inst})
1655     {
1656         my $uc_pkgname = uc ($pkgname);
1657
1658         print <<EOF;
1659     <Property Id="INST_$uc_pkgname">
1660       <IniFileSearch Id='gpg4win_ini_inst_$pkgname' Type='raw'
1661        Name='gpg4win.ini' Section='gpg4win' Key='inst_$pkgname'/>
1662     </Property>
1663
1664 EOF
1665     }
1666 }
1667
1668 print <<EOF;
1669     <Directory Id='TARGETDIR' Name='SourceDir'>
1670       <Directory Id='ProgramFilesFolder' Name='PFiles'>
1671         <!-- DIR_GnuPG is used be the GnuPG wxlib -->
1672         <Directory Id='DIR_GnuPG' Name='GnuPG'/>
1673         <Directory Id='INSTDIR' Name='Gpg4win'>
1674 EOF
1675
1676 $::level = 12;
1677 dump_all ($parser);
1678
1679
1680 print <<EOF;
1681         </Directory>
1682       </Directory>
1683 EOF
1684
1685 if (scalar keys %{$parser->{shortcuts}})
1686 {
1687     my $name = nsis_fetch ($parser, 'PRETTY_PACKAGE');
1688
1689     print <<EOF;
1690       <Directory Id='ProgramMenuFolder' Name='PMenu'>
1691         <Directory Id='ProgramMenuDir' Name='$name'/>
1692       </Directory>
1693 EOF
1694 }
1695
1696 #print <<EOF;
1697 #      <Directory Id="DesktopFolder" Name="Desktop"/>
1698 #EOF
1699
1700
1701 print <<EOF;
1702     </Directory>
1703
1704     <Feature Id='Complete' Title='Gpg4win' Description='All components.'
1705              Display='expand' Level='1' ConfigurableDirectory='INSTDIR'>
1706 EOF
1707
1708 $::level = 6;
1709 dump_all2 ($parser);
1710
1711 #    <Icon Id="Foobar10.exe" SourceFile="FoobarAppl10.exe"/>
1712
1713 # Removed this, because it is not localized:
1714 #    <UIRef Id='WixUI_ErrorProgressText' />
1715
1716 print <<EOF;
1717     </Feature>
1718
1719     <!-- Launch Kleopatra after setup exits -->
1720     <CustomAction Id            = "StartAppOnExit"
1721                   FileKey       = "kleopatra.exe"
1722                   ExeCommand    = ""
1723                   Execute       = "immediate"
1724                   Impersonate   = "yes"
1725                   Return        = "asyncNoWait" />
1726     <Property Id="WIXUI_EXITDIALOGOPTIONALCHECKBOXTEXT"
1727       Value="Launch Kleopatra" />
1728     <Property Id="WIXUI_EXITDIALOGOPTIONALCHECKBOX" Value="1" />
1729
1730     <WixVariable Id='WixUILicenseRtf' Value='gpl.rtf'/>
1731
1732     <!-- Set up the UI -->
1733
1734     <UIRef Id='WixUI_Advanced' />
1735
1736   </Product>
1737 </Wix>
1738 EOF
1739
1740 # Post-processing: We need to remember the GUIDs for later reuse, and
1741 # we remember the files we need in case we want to transfer them to a
1742 # different machine for invocation of WiX.
1743
1744 store_guids ();
1745 store_files ($parser);