MSI: Fix possible use of unintialized variable
[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", "cairo", "fontconfig");
694
695 sub gpg4win_nsis_stubs
696 {
697     my ($parser, $file, $command, @args) = @_;
698
699     $parser->{state} = "" if not defined $parser->{state};
700
701     if ($parser->{state} =~ m/^ignore-until-(.*)$/)
702     {
703         undef $parser->{state} if ($command eq $1);
704     }
705
706     # Section support.
707     #
708     # We parse SetOutPath and File directives in sections.
709     # Everything else is ignored.
710
711     elsif ($parser->{state} eq ''
712             and ($command eq 'Section' or $command eq '${MementoSection}'
713                 or $command eq '${MementoUnselectedSection}'))
714     {
715         my $idx = 0;
716         # Default install level for MSI is 3.
717         my $level = $::nsis_level_default;
718         my $hidden = 0;
719
720         if ($command eq '${MementoUnselectedSection}')
721         {
722             # Default install level for MSI is 3.
723             $level = $::nsis_level_optional;
724         }
725
726         # Check for options first.
727         return if ($idx > $#args);
728         if ($args[$idx] eq '/o')
729         {
730             # Default install level for MSI is 3.
731             $level = $::nsis_level_optional;
732             $idx++;
733         }
734
735         return if ($idx > $#args);
736
737         my $title = nsis_eval ($parser, $file, $args[$idx++]);
738
739         # Check for hidden flag.
740         if (substr ($title, 0, 1) eq '-')
741         {
742             # Hidden packages are dependency tracked and never
743             # installed by default unless required.
744             $level = $::nsis_level_hidden;
745             $hidden = 1;
746             substr ($title, 0, 1) = '';
747         }
748
749         # We only pay attention to special sections and those which
750         # have a section index defined.
751         if ($title eq 'startmenu')
752         {
753             # The special startmenu section contains all our shortcuts.\
754             $parser->{state} = 'section-startmenu';
755             return;
756         }
757         elsif ($idx > $#args)
758         {
759             return;
760         }
761
762         # Finally we can get the frobbed name of the package.
763         my $name = $args[$idx++];
764         $name =~ s/^SEC_//;
765
766         my $pkg = \%{$parser->{pkgs}->{$name}};
767
768         # Check for ignored packages
769         foreach my $ignored (%::ignored_pkgs)
770         {
771             if ($name eq $ignored)
772             {
773                 print STDERR "Ignoring package: " . $name . "\n"
774                 if $::nsis_parser_debug;
775                 return;
776             }
777         }
778
779         $pkg->{name} = $name;
780         # Replace - in names to avoid errors with identifies
781         $pkg->{name} =~ s/-/_/g;
782         $pkg->{title} = $title;
783         $pkg->{level} = $level;
784         $pkg->{hidden} = $hidden;
785         $pkg->{features} = '';
786
787         # Remember the order of sections included.
788         push @{$parser->{pkg_list}}, $name;
789
790         $parser->{pkg} = $pkg;
791         $parser->{state} = 'in-section';
792     }
793     elsif ($parser->{state} eq 'in-section')
794     {
795         if ($command eq 'SectionEnd' or $command eq '${MementoSectionEnd}')
796         {
797             delete $parser->{pkg};
798             undef $parser->{state};
799         }
800         elsif ($command eq 'SetOutPath')
801         {
802             fail "$file:$.: syntax error" if ($#args != 0);
803
804             my $outpath = $args[0];
805             #       if (not $outpath =~ s/^"\$INSTDIR\\?(.*)"$/$1/)
806             if ($outpath =~ m/^"\$INSTDIR\\?(.*)"$/)
807             {
808                 $parser->{outpath} = $1;
809             }
810             elsif ($outpath =~ m/^"\$APPDATA\\?(.*)"$/)
811             {
812                 $parser->{outpath} = "%CommonAppDataFolder%\\" . $1;
813             }
814             elsif ($outpath =~ m/^"\$TEMP\\?(.*)"$/)
815             {
816                 $parser->{outpath} = "%TEMP%\\" . $1;
817             }
818             elsif ($outpath =~ m/^"\$PLUGINSDIR\\?(.*)"$/)
819             {
820                 $parser->{outpath} = "REMOVE_ME\\" . $1;
821             }
822             else
823             {
824                 fail "$file:$.: unsupported out path: $args[0]";
825             }
826         }
827         elsif ($command eq 'File')
828         {
829             my $idx = 0;
830             my $target;
831
832             fail "$file:$.: not supported" if ($#args < 0 || $#args > 1);
833
834             if ($#args == 1)
835             {
836                 if ($args[0] eq '/nonfatal')
837                 {
838                     print STDERR "$file:$.: warning: skipping non-fatal file $args[1]\n"
839                     if $::nsis_parser_warn;
840                     return;
841                 }
842
843                 $target = $args[0];
844                 if (not $target =~ s,^/oname=(.*)$,$1,)
845                 {
846                     fail "$file:$.: syntax error";
847                 }
848
849                 # Temp files are due to overwrite attempts, which are
850                 # handled automatically by the Windows Installer.  Ignore
851                 # them here.
852                 return if $target =~ m/\.tmp$/;
853                 $idx++;
854             }
855
856             my $source = nsis_eval ($parser, $file, $args[$idx]);
857             if (not defined $target)
858             {
859                 $target = $source;
860                 $target =~ s,^.*/([^/\\]+)$,$1,;
861             }
862
863             push @{$parser->{pkg}->{files}}, { source => $source,
864                 dir => $parser->{outpath},
865                 target => $target };
866         }
867         elsif ($command eq 'WriteRegStr')
868         {
869             fail "$file:$.: not supported" if ($#args != 3);
870
871             my $root = $args[0];
872
873             my $key = $args[1];
874             $key =~ s/^"(.*)"$/$1/;
875
876             my $name = $args[2];
877             $name =~ s/^"(.*)"$/$1/;
878
879             my $value = $args[3];
880             $value =~ s/^"(.*)"$/$1/;
881             $value =~ s/\$INSTDIR\\?/\[INSTDIR\]/g;
882
883             push (@{$parser->{pkg}->{registry}},
884                 { root => $root, key => $key, name => $name,
885                     value => $value, type => 'string' });
886         }
887     }
888
889     # Start menu shortcuts support.
890
891     elsif ($parser->{state} eq 'section-startmenu')
892     {
893         if ($command eq 'SectionEnd' or $command eq '${MementoSectionEnd}')
894         {
895             undef $parser->{state};
896         }
897         elsif ($command eq 'CreateShortCut')
898         {
899             fail "$file:$.: not supported" if ($#args != 7);
900
901             # The link may contains a translatable string.
902             my $link = $args[0];
903
904             # We filter for startmenu shortcuts, as the others are
905             # just more of the same.  Equivalently, we could filter
906             # for a block between two labels.
907             return if ($link !~ m/STARTMENU_FOLDER/);
908
909             # Take the base name of the link.
910             # FIXME: We want the manuals in a subdirectory.
911             $link =~ s/^.*\\([^\\]*)\"$/$1/;
912             $link =~ s/\.lnk$//;
913
914             my $target = nsis_eval ($parser, $file, $args[1]);
915             $target =~ s/^\$INSTDIR\\//;
916
917             my $icon = $args[3];
918             $icon =~ s/^"(.*)"$/$1/;
919             $icon =~ s/^\$INSTDIR\\/[INSTDIR]/;
920             $icon = nsis_eval ($parser, $file, $icon);
921
922             my $icon_idx = nsis_eval ($parser, $file, $args[4]);
923             fail "$file:$.: not supported" if ($icon_idx ne '');
924
925             # The description contains a translatable string.
926             my $description = $args[7];
927
928             $parser->{shortcuts}->{$target} = { link => $link,
929                 target => $target,
930                 icon => $icon,
931                 description => $description };
932         }
933     }
934
935     # LangString support.
936     #
937     # LangString directives must be stated at the top-level of the file.
938
939     elsif ($parser->{state} eq '' and $command eq 'LangString')
940     {
941         fail "$file:$.: syntax error" if ($#args != 2);
942
943         my $lang = $args[1];
944         $lang =~ s/^\$\{LANG_(\w*)\}$/$1/;
945         if ($lang eq 'ENGLISH')
946         {
947             $lang = 'en';
948         }
949         elsif ($lang eq 'GERMAN')
950         {
951             $lang = 'de';
952         }
953         elsif ($lang eq 'ARABIC')
954         {
955             $lang = 'ar';
956         }
957         elsif ($lang eq 'SPANISH')
958         {
959             $lang = 'es';
960         }
961         elsif ($lang eq 'FRENCH')
962         {
963             $lang = 'fr';
964         }
965         elsif ($lang eq 'RUSSIAN')
966         {
967             $lang = 'ru';
968         }
969         elsif ($lang eq 'PORTUGUESE')
970         {
971             $lang = 'pt';
972         }
973         elsif ($lang eq 'CZECH')
974         {
975             $lang = 'cz';
976         }
977         elsif ($lang eq 'ITALIAN')
978         {
979             $lang = 'it';
980         }
981         elsif ($lang eq 'SIMPCHINESE')
982         {
983             $lang = 'zh_CN';
984         }
985         elsif ($lang eq 'TRADCHINESE')
986         {
987             $lang = 'zh_TW';
988         }
989         elsif ($lang eq 'NORWEGIAN')
990         {
991             $lang = 'no';
992         }
993         elsif ($lang eq 'DUTCH')
994         {
995             $lang = 'nl';
996         }
997         else
998         {
999             fail "$file:$.: unsupported language ID $args[1]";
1000         }
1001         $parser->{po}->{$lang}->{$args[0]} = $args[2];
1002     }
1003
1004     # Function support.
1005     #
1006     # Most functions are ignored.  Some are of special interest and
1007     # are parsed separately.
1008
1009     elsif ($parser->{state} eq '' and $command eq 'Function')
1010     {
1011         fail "$file:$.: syntax error" if ($#args != 0);
1012
1013         if ($args[0] eq 'CalcDepends')
1014         {
1015             $parser->{state} = 'function-calc-depends';
1016         }
1017         elsif ($args[0] eq 'CalcDefaults')
1018         {
1019             $parser->{state} = 'function-calc-defaults';
1020         }
1021         else
1022         {
1023             # Functions we do not find interesting are skipped.
1024             print STDERR
1025             "$file:$.: warning: ignoring function $args[0]\n"
1026             if $::nsis_parser_warn;
1027             delete $parser->{dep_name};
1028             $parser->{state} = 'ignore-until-FunctionEnd';
1029         }
1030     }
1031
1032     # Function calc-depends.
1033     #
1034     # This function gathers information about dependencies between
1035     # features.  Features are identified by their frobbed names.  The
1036     # format is as such: First, a couple of UnselectSection macros,
1037     # one for each dependency.  Then SelectSection invocations for all
1038     # packages which should always be installed (mandatory), followed
1039     # by one block for each feature, consisting of a label "have_FOO:"
1040     # where FOO is the frobbed package name (in lowercase, usually),
1041     # followed by SelectSection invocations, one for each dependency,
1042     # and finally a "skip_FOO:" label to finish the block.
1043     #
1044     # The order of these statements and blocks must be so that a single pass
1045     # through the list is sufficient to resolve all dependencies, that means
1046     # in pre-fix order.
1047
1048     elsif ($parser->{state} eq 'function-calc-depends')
1049     {
1050         if ($command eq 'FunctionEnd')
1051         {
1052             undef $parser->{state};
1053         }
1054         elsif ($command =~ m/^have_(.*):$/)
1055         {
1056             $parser->{dep_name} = $1;
1057             $parser->{pkgs}->{$1}->{deps} = {};
1058         }
1059         elsif ($command eq '!insertmacro')
1060         {
1061             fail "$file:$.: syntax error" if $#args < 0;
1062             if ($args[0] eq 'SelectSection')
1063             {
1064                 fail "$file:$.: syntax error" if $#args != 1;
1065                 my $name = $args[1];
1066                 $name =~ s/^\$\{SEC_(.*)\}$/$1/;
1067
1068                 if (not exists $parser->{dep_name})
1069                 {
1070                     # A stray SelectSection chooses defaults.
1071                     $parser->{pkgs}->{$name}->{features} .=
1072                     " Absent='disallow'";
1073                 }
1074                 else
1075                 {
1076                     my $dep_name = $parser->{dep_name};
1077                     print STDERR "DEP: Add " . $name . " as a dependency for " .
1078                     $dep_name . "\n" if $::nsis_parser_debug;
1079
1080                     # Add $name as a dependency for $dep_name.
1081                     $parser->{pkgs}->{$dep_name}->{deps}->{$name} = 1;
1082                 }
1083             }
1084         }
1085         elsif ($command =~ m/^skip_(.*):$/)
1086         {
1087             fail "$file:$.: stray skip_FOO label"
1088             if not exists $parser->{dep_name};
1089
1090             my $dep_name = $parser->{dep_name};
1091             my $dep_pkg = $parser->{pkgs}->{$dep_name};
1092
1093             # We resolve indirect dependencies right now.  This works
1094             # because dependencies are required to be listed in
1095             # pre-fix order.
1096
1097             foreach my $name (keys %{$parser->{pkgs}})
1098             {
1099                 my $pkg = $parser->{pkgs}->{$name};
1100
1101                 # Check if $dep_name is a dependency for $name.
1102                 if (exists $pkg->{deps}->{$dep_name})
1103                 {
1104                     # Add all dependencies of $dep_name to $name.
1105                     foreach my $dep (keys %{$dep_pkg->{deps}})
1106                     {
1107                         $pkg->{deps}->{$dep} = $pkg->{deps}->{$dep_name} + 1
1108                         if (not defined $pkg->{deps}->{$dep});
1109                     }
1110                 }
1111             }
1112             delete $parser->{dep_name};
1113         }
1114     }
1115
1116     # Function calc-depends.
1117     #
1118     # Format:
1119     # g4wihelp::config_fetch_bool "inst_FOO"
1120
1121     elsif ($parser->{state} eq 'function-calc-defaults')
1122     {
1123         if ($command eq 'FunctionEnd')
1124         {
1125             undef $parser->{state};
1126         }
1127         elsif ($command eq 'g4wihelp::config_fetch_bool')
1128         {
1129             fail "$file:$.: syntax error" if $#args != 0;
1130
1131             if ($args[0] !~ m/^"inst_(.*)"$/)
1132             {
1133                 fail "$file:$.: syntax error";
1134             }
1135
1136             $parser->{pkgs}->{$1}->{ini_inst} = 1;
1137         }
1138     }
1139 }
1140
1141 \f
1142 # MSI generator.
1143
1144 # Simple indentation tracking, for pretty printing.
1145 $::level = 0;
1146
1147
1148 sub dump_all
1149 {
1150     my ($parser) = @_;
1151
1152     my $pkgname;
1153     # A running count for files within each feature.
1154     my $fileidx;
1155     # A running count for registry settings within each feature.
1156     my $regidx;
1157     # A running count for directories throughout the whole file.
1158     my $diridx = 0;
1159     # The current directory.
1160     my $cdir = '';
1161
1162     foreach $pkgname (@{$parser->{pkg_list}})
1163     {
1164         my $pkg = $parser->{pkgs}->{$pkgname};
1165
1166         $fileidx = 0;
1167         foreach my $file (@{$pkg->{files}})
1168         {
1169             if ($cdir ne $file->{dir})
1170             {
1171                 # We need to change the directory.  We weed out empty
1172                 # path elements, which also takes care of leading slashes.
1173                 my @cdir = grep (!/^$/, split (/\\/, $cdir));
1174                 my @ndir = grep (!/^$/, split (/\\/, $file->{dir}));
1175                 my $min;
1176                 my $i;
1177                 $min = $#cdir;
1178                 $min = $#ndir if ($#ndir < $min);
1179                 for ($i = 0; $i <= $min; $i++)
1180                 {
1181                     last if ($cdir[$i] ne $ndir[$i])
1182                 }
1183                 my $j;
1184                 for ($j = $i; $j <= $#cdir; $j++)
1185                 {
1186                     $::level -= 2;
1187                     print ' ' x $::level
1188                     . "</Directory>\n";
1189                 }
1190                 for ($j = $i; $j <= $#ndir; $j++)
1191                 {
1192                     print ' ' x $::level
1193                     . "<Directory Id='d_$diridx' Name='$ndir[$j]'>\n";
1194                     $diridx++;
1195                     $::level += 2;
1196                 }
1197                 $cdir = $file->{dir};
1198             }
1199
1200             my $targetfull;
1201             if ($file->{dir} ne '')
1202             {
1203                 $targetfull = $file->{dir} . '\\' . $file->{target};
1204             }
1205             else
1206             {
1207                 $targetfull = $file->{target};
1208             }
1209
1210             print ' ' x $::level
1211             . "<Component Id='c_$pkg->{name}_$fileidx' Guid='"
1212             . get_guid ($targetfull) . "'>\n";
1213             my $sourcefull;
1214             $sourcefull = $file->{source};
1215             $sourcefull =~ s/playground\/install-ex/\$(var.InstDirEx)/;
1216             $sourcefull =~ s/playground\/install/\$(var.InstDir)/;
1217             $sourcefull =~ s/\.\//\$(var.SrcDir)\//;
1218             $sourcefull =~ s/\//\\/g;
1219             print ' ' x $::level
1220             . "  <File Id='f_$pkg->{name}_$fileidx' Name='"
1221             . $file->{target} ."' KeyPath='yes'" . " Source='" .
1222             $sourcefull . "'>\n";
1223             # Does not help to avoid the warnings: DefaultLanguage='1033'.
1224
1225             # EXCEPTIONS:
1226             if ($targetfull eq 'gpgol.dll')
1227             {
1228                 print ' ' x $::level
1229                 . "    <Class Id='{42D30988-1A3A-11DA-C687-000D6080E735}' "
1230                 . "Context='InprocServer32' Description='GpgOL - The "
1231                 . "GnuPG Outlook Plugin' ThreadingModel='apartment'/>\n";
1232             }
1233             if ($targetfull eq 'gpgex.dll')
1234             {
1235                 print ' ' x $::level
1236                 . "    <Class Id='{CCD955E4-5C16-4A33-AFDA-A8947A94946B}' "
1237                 . "Context='InprocServer32' Description='GpgEX' "
1238                 . "ThreadingModel='apartment'/>\n";
1239             }
1240             # Create shortcuts.
1241             if (defined $parser->{shortcuts}->{$targetfull})
1242             {
1243                 my $shortcut = $parser->{shortcuts}->{$targetfull};
1244                 my $extra = '';
1245
1246                 if (exists $shortcut->{description})
1247                 {
1248                     my $desc = nsis_translate ($parser, '',
1249                         $shortcut->{description});
1250                     $extra .= " Description='$desc'";
1251                 }
1252                 # FIXME: WiX wants the icon to be known at compile time, so it needs a
1253                 # source file, not a target file name.
1254                 #       if ($shortcut->{icon} ne '')
1255                 #       {
1256                 #           $extra .= " Icon='sm_$pkg->{name}_${fileidx}_icon'";
1257                 #       }
1258
1259                 # FIXME: Note that the link name should better not
1260                 # change, or it is not correctly replaced on updates.
1261                 my $link = nsis_translate ($parser, '', $shortcut->{link});
1262                 print ' ' x $::level
1263                 . "    <Shortcut Id='sm_$pkg->{name}_$fileidx' "
1264                 . "Directory='ProgramMenuDir' Name='$link'"
1265                 . $extra;
1266
1267                 #       if ($shortcut->{icon} eq '')
1268                 #       {
1269                 print "/>\n";
1270                 #       }
1271                 #       else
1272                 #       {
1273                 #           print ">\n";
1274                 #           print ' ' x $::level
1275                 #           . "      <Icon Id='sm_$pkg->{name}_${fileidx}_icon' "
1276                 #           . "SourceFile='$shortcut->{icon}'/>\n";
1277                 #           print ' ' x $::level
1278                 #           . "    </Shortcut>\n";
1279                 #       }
1280
1281                 # Can't make these optional, so we don't do this.
1282                 #       print ' ' x $::level
1283                 #                   . "    <Shortcut Id='dt_$pkg->{name}_$fileidx' "
1284                 #           . "Directory='DesktopFolder' Name='$file->{target}'/>\n";
1285             }
1286
1287             print ' ' x $::level
1288             . "  </File>\n";
1289
1290             if (defined $parser->{shortcuts}->{$targetfull})
1291             {
1292                 # http://www.mail-archive.com/wix-users@lists.sourceforge.net/msg02746.html
1293                 # -sice:ICE64
1294                 print ' ' x $::level
1295                 . "  <RemoveFolder Id='rsm_$pkg->{name}_$fileidx' "
1296                 . "Directory='ProgramMenuDir' On='uninstall'/>\n";
1297             }
1298
1299             # EXCEPTIONS:
1300             # We use $targetfull because there is also a gpg.exe in pub\.
1301             if ($targetfull eq 'gpg.exe')
1302             {
1303                 print ' ' x $::level
1304                 . "  <Environment Id='env_path' Name='PATH' Action='set' "
1305                 . "System='yes' Part='last' Value='[INSTDIR]pub'/>\n";
1306             }
1307             elsif ($targetfull eq 'gpgol.dll')
1308             {
1309                 print ' ' x $::level
1310                 . "  <RegistryValue Root='HKLM' Key='Software\\"
1311                 . "Microsoft\\Exchange\\Client\\Extensions' "
1312                 . "Name='GpgOL' "
1313                 . "Value='4.0;[!gpgol.dll];1;11000111111100;11111101' "
1314                 . "Type='string' Action='write'/>\n";
1315                 print ' ' x $::level
1316                 . "  <RegistryValue Root='HKLM' Key='Software\\"
1317                 . "Microsoft\\Exchange\\Client\\Extensions' "
1318                 . "Name='Outlook Setup Extension' "
1319                 . "Value='4.0;Outxxx.dll;7;000000000000000;0000000000;OutXXX' "
1320                 . "Type='string' Action='write'/>\n";
1321             }
1322             elsif ($targetfull eq 'gpgex.dll')
1323             {
1324                 print ' ' x $::level
1325                 . "  <ProgId Id='*'/>\n";
1326                 print ' ' x $::level
1327                 . "  <ProgId Id='Directory'/>\n";
1328                 print ' ' x $::level
1329                 . "  <RegistryValue Root='HKCR' "
1330                 . "Key='*\\ShellEx\\ContextMenuHandlers\\GpgEX' "
1331                 . "Value='{CCD955E4-5C16-4A33-AFDA-A8947A94946B}' "
1332                 . "Type='string' Action='write'/>\n";
1333                 print ' ' x $::level
1334                 . "  <RegistryValue Root='HKCR' "
1335                 . "Key='Directory\\ShellEx\\ContextMenuHandlers\\GpgEX' "
1336                 . "Value='{CCD955E4-5C16-4A33-AFDA-A8947A94946B}' "
1337                 . "Type='string' Action='write'/>\n";
1338             }
1339             elsif ($targetfull eq 'gpgee.dll')
1340             {
1341                 print STDERR "ERR: run heat.exe on gpgee.dll and add info\n";
1342                 exit 1;
1343             }
1344
1345             print ' ' x $::level
1346             . "</Component>\n";
1347             $fileidx++;
1348         }
1349
1350         $regidx = 0;
1351         foreach my $reg (@{$pkg->{registry}})
1352         {
1353             my $target;
1354             my $root;
1355
1356             if ($reg->{root} eq 'SHCTX')
1357             {
1358                 $root = 'HKMU';
1359             }
1360             else
1361             {
1362                 $root = $reg->{root};
1363             }
1364
1365             my $localValue;
1366
1367             # Some values need to be translated, like descriptions.
1368             if ($reg->{value} =~ m/^\$/)
1369             {
1370                 $localValue = nsis_translate ($parser, '', $reg->{value});
1371             }
1372             else
1373             {
1374                 $localValue = $reg->{value};
1375             }
1376
1377             $target = '/REGISTRY/' . $reg->{root} . '/' . $reg->{key}
1378             . '/' . $reg->{name};
1379
1380             my $namepart="";
1381             if ($reg->{name} ne "")
1382             {
1383                 $namepart = "Name='$reg->{name}' ";
1384             }
1385
1386             print ' ' x $::level
1387             . "<Component Id='c_$pkg->{name}_r_$regidx' Guid='"
1388             . get_guid ($target) . "' KeyPath='yes'>\n";
1389             print ' ' x $::level
1390             . "  <RegistryValue Id='r_$pkg->{name}_$regidx' Root='"
1391             . $root . "' Key='" . $reg->{key} . "' " . $namepart
1392             . " Action='write' Type='" . $reg->{type}
1393             . "' Value='" . $localValue . "'/>\n";
1394             print ' ' x $::level
1395             . "</Component>\n";
1396             $regidx++;
1397         }
1398     }
1399
1400     my @cdir = grep (!/^$/, split (/\\/, $cdir));
1401     my $j;
1402     for ($j = 0; $j <= $#cdir; $j++)
1403     {
1404         $::level -= 2;
1405         print ' ' x $::level
1406         . "</Directory>\n";
1407     }
1408 }
1409
1410
1411 sub dump_meat
1412 {
1413     my ($pkg) = @_;
1414     my $fileidx;
1415     my $regidx;
1416
1417     $fileidx = 0;
1418     foreach my $file (@{$pkg->{files}})
1419     {
1420         print ' ' x $::level
1421         . "  <ComponentRef Id='c_$pkg->{name}_$fileidx'/>\n";
1422         $fileidx++;
1423     }
1424     $regidx = 0;
1425     foreach my $reg (@{$pkg->{registry}})
1426     {
1427         print ' ' x $::level
1428         . "  <ComponentRef Id='c_$pkg->{name}_r_$regidx'/>\n";
1429         $regidx++;
1430     }
1431 }
1432
1433
1434 sub dump_all2
1435 {
1436     my ($parser) = @_;
1437
1438     my $pkgname;
1439
1440     foreach $pkgname (@{$parser->{pkg_list}})
1441     {
1442         my $pkg = $parser->{pkgs}->{$pkgname};
1443         my $features;
1444
1445         next if $pkg->{hidden};
1446
1447         $features = $pkg->{features};
1448         #   $features .= " Display='hidden'" if $pkg->{hidden};
1449         $features .= " Description='$pkg->{description}'"
1450         if $pkg->{description};
1451
1452         my $title = nsis_translate ($parser, '', $pkg->{title});
1453
1454         print ' ' x $::level
1455         . "<Feature Id='p_$pkg->{name}' Level='$pkg->{level}' "
1456         . "Title='$title'" . $features . ">\n";
1457         if ($pkg->{ini_inst})
1458         {
1459             my $uc_pkgname = uc ($pkgname);
1460
1461             print ' ' x $::level
1462             . "<Condition Level='$::nsis_level_default'>"
1463             . "INST_$uc_pkgname = \"true\"</Condition>\n";
1464             print ' ' x $::level
1465             . "<Condition Level='$::nsis_level_optional'>"
1466             . "INST_$uc_pkgname = \"false\"</Condition>\n";
1467         }
1468
1469         dump_meat ($pkg);
1470
1471         foreach my $dep (keys %{$pkg->{deps}})
1472         {
1473             $dep =~ s/-/_/g;
1474             my $deppkg = $parser->{pkgs}->{$dep};
1475
1476             # We use Level=1 because with InstallDefault followParent
1477             # the Level seems to specify some sort of minimum install
1478             # level or something (FIXME: confirm this).
1479             print ' ' x $::level
1480             . "  <Feature Id='p_$pkg->{name}_$dep' "
1481             . "Title='p_$pkg->{name}_$dep' "
1482             . "Level='1' Display='hidden' "
1483             . "InstallDefault='followParent'>\n";
1484             $::level += 2;
1485             dump_meat ($deppkg);
1486             $::level -= 2;
1487             print ' ' x $::level
1488             . "  </Feature>\n";
1489         }
1490         print ' ' x $::level
1491         . "</Feature>\n";
1492     }
1493 }
1494
1495 \f
1496 # Just so that it is defined.
1497 $. = 0;
1498
1499 my %parser = ( pre_depth => 0, pre_true => 0 );
1500 my $parser = \%parser;
1501
1502 fetch_guids ();
1503
1504 while ($#ARGV >= 0 and $ARGV[0] =~ m/^-/)
1505 {
1506     my $opt = shift @ARGV;
1507     if ($opt =~ m/^--guids$/)
1508     {
1509         $::guid_file = shift @ARGV;
1510     }
1511     elsif ($opt =~ m/^--manifest$/)
1512     {
1513         $::files_file = shift @ARGV;
1514     }
1515     elsif ($opt =~ m/^-D([^=]*)=(.*)$/)
1516     {
1517         $parser->{pre_symbols}->{$1} = $2;
1518     }
1519     elsif ($opt =~ m/^-L(.*)$/)
1520     {
1521         $::lang = $1;
1522         # Test if it is supported.
1523         lang_to_lcid ($::lang);
1524     }
1525     elsif ($opt eq '--usage')
1526     {
1527         print STDERR "Usage: $0 [-DNAME=VALUE...] NSIFILE\n";
1528         print STDERR "Use --help or -h for more information.\n";
1529         exit 1;
1530     }
1531     elsif ($opt eq '-h' or $opt eq '--help')
1532     {
1533         print STDERR "Usage: $0 [-DNAME=VALUE...] NSIFILE\n";
1534         print STDERR "Convert the .nsi file NSIFILE to a WiX source file.\n";
1535         print STDERR "Options:\n";
1536         print STDERR "       --guids NAME     Save GUIDs into file NAME (default: $::guid_file)\n";
1537         print STDERR "       --manifest NAME  Save included files into file NAME (default: $::files_file)\n";
1538         print STDERR "       -DNAME=VALUE     Define preprocessor symbol NAME to VALUE\n";
1539         print STDERR "       -LLANG           Build installer for language LANG (default: $::lang)\n";
1540         print STDERR "\n";
1541         print STDERR "       -h|--help        Print this help and exit\n";
1542         exit 0;
1543     }
1544     else
1545     {
1546         print STDERR "$0: unknown option $opt\n";
1547         print STDERR "Usage: $0 [-DNAME=VALUE...] NSIFILE\n";
1548         print STDERR "Use --help or -h for more information.\n";
1549         exit 1;
1550     }
1551 }
1552
1553
1554 if ($#ARGV < 0)
1555 {
1556     nsis_parse_file ($parser, '-');
1557 }
1558 else
1559 {
1560     nsis_parse_file ($parser, $ARGV[0]);
1561 }
1562
1563 # Add exceptions.
1564 # ===============
1565
1566 $parser->{pkgs}->{gnupg}->{deps}->{gpg4win} = 1;
1567
1568 # For debugging:
1569 # use Data::Dumper;
1570 # print Dumper ($parser);
1571 # exit;
1572
1573 # Dump the gathered information.
1574 # ==============================
1575
1576 my $BUILD_FILEVERSION = nsis_fetch ($parser, '_BUILD_FILEVERSION');
1577
1578 my $product_id = get_guid ("/PRODUCT/$BUILD_FILEVERSION");
1579 my $upgrade_code = get_guid ("/UPGRADE/1");
1580
1581 my $INSTALL_DIR = nsis_fetch ($parser, 'INSTALL_DIR');
1582
1583 my $lcid = lang_to_lcid ($::lang);
1584
1585 print <<EOF;
1586 <?xml version='1.0'?>
1587 <Wix xmlns='http://schemas.microsoft.com/wix/2006/wi'>
1588   <!-- The general product setup -->
1589   <Product Name='Gpg4win Enterprise'
1590            Id='$product_id'
1591            UpgradeCode='$upgrade_code'
1592            Language='$lcid'
1593            Codepage='1252'
1594            Version='$BUILD_FILEVERSION'
1595            Manufacturer='GnuPG.com'>
1596     <Package Description='Gpg4win Enterprise Installer'
1597              Comments='http://www.gnupg.com/'
1598              Compressed='yes'
1599              InstallerVersion='200'
1600              Manufacturer='GnuPG.com'
1601              Languages='1033' SummaryCodepage='1252'/>
1602
1603     <Condition Message="At least Windows 7 or Server 2008 R2 required.">
1604         <![CDATA[Installed OR (VersionNT >= 601)]]>
1605     </Condition>
1606
1607     <InstallExecuteSequence>
1608       <RemoveExistingProducts After='InstallFinalize' />
1609     </InstallExecuteSequence>
1610
1611     <Upgrade Id='$upgrade_code'>
1612       <UpgradeVersion Property='UPGRADEPROP'
1613                       IncludeMaximum='no'
1614                       Maximum='$BUILD_FILEVERSION'/>
1615     </Upgrade>
1616
1617     <!-- Set up Properties -->
1618     <MediaTemplate EmbedCab="yes" />
1619     <!-- 2 is like highest available in msi -->
1620     <Property Id="ALLUSERS" Value="2" />
1621
1622     <Property Id="INSTDIR">
1623       <RegistrySearch Id='gpg4win_instdir_registry' Type='raw'
1624        Root='HKLM' Key='Software\\Gpg4win' Name='Install Directory'/>
1625       <IniFileSearch Id='gpg4win_instdir_ini' Type='raw'
1626        Name='gpg4win.ini' Section='gpg4win' Key='instdir'/>
1627     </Property>
1628
1629     <!-- Set up the UI -->
1630
1631     <Feature Id="Feature_GnuPG"
1632          Title="GnuPG"
1633          Level="1"
1634          Absent='disallow'>
1635       <ComponentGroupRef Id="CMP_GnuPG" />
1636     </Feature>
1637
1638 EOF
1639
1640 foreach my $pkgname (@{$parser->{pkg_list}})
1641 {
1642     if (exists $parser->{pkgs}->{$pkgname}->{ini_inst})
1643     {
1644         my $uc_pkgname = uc ($pkgname);
1645
1646         print <<EOF;
1647     <Property Id="INST_$uc_pkgname">
1648       <IniFileSearch Id='gpg4win_ini_inst_$pkgname' Type='raw'
1649        Name='gpg4win.ini' Section='gpg4win' Key='inst_$pkgname'/>
1650     </Property>
1651
1652 EOF
1653     }
1654 }
1655
1656 print <<EOF;
1657     <Directory Id='TARGETDIR' Name='SourceDir'>
1658       <Directory Id='ProgramFilesFolder' Name='PFiles'>
1659         <!-- DIR_GnuPG is used be the GnuPG wxlib -->
1660         <Directory Id='DIR_GnuPG' Name='GnuPG'/>
1661         <Directory Id='INSTDIR' Name='Gpg4win'>
1662 EOF
1663
1664 $::level = 12;
1665 dump_all ($parser);
1666
1667
1668 print <<EOF;
1669         </Directory>
1670       </Directory>
1671 EOF
1672
1673 if (scalar keys %{$parser->{shortcuts}})
1674 {
1675     my $name = nsis_fetch ($parser, 'PRETTY_PACKAGE');
1676
1677     print <<EOF;
1678       <Directory Id='ProgramMenuFolder' Name='PMenu'>
1679         <Directory Id='ProgramMenuDir' Name='$name'/>
1680       </Directory>
1681 EOF
1682 }
1683
1684 #print <<EOF;
1685 #      <Directory Id="DesktopFolder" Name="Desktop"/>
1686 #EOF
1687
1688
1689 print <<EOF;
1690     </Directory>
1691
1692     <Feature Id='Complete' Title='Gpg4win' Description='All components.'
1693              Display='expand' Level='1' ConfigurableDirectory='INSTDIR'>
1694 EOF
1695
1696 $::level = 6;
1697 dump_all2 ($parser);
1698
1699 #    <Icon Id="Foobar10.exe" SourceFile="FoobarAppl10.exe"/>
1700
1701 # Removed this, because it is not localized:
1702 #    <UIRef Id='WixUI_ErrorProgressText' />
1703
1704 print <<EOF;
1705     </Feature>
1706
1707     <WixVariable Id='WixUILicenseRtf' Value='gpl.rtf'/>
1708     <UIRef Id='WixUI_Mondo' />
1709
1710   </Product>
1711 </Wix>
1712 EOF
1713
1714 # Post-processing: We need to remember the GUIDs for later reuse, and
1715 # we remember the files we need in case we want to transfer them to a
1716 # different machine for invocation of WiX.
1717
1718 store_guids ();
1719 store_files ($parser);