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