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