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