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