/[meteor]/googlecode.com/svn/trunk/Meteor/Config.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /googlecode.com/svn/trunk/Meteor/Config.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 9 by andrew.betts, Fri Dec 8 16:52:58 2006 UTC revision 32 by andrew.betts, Thu Dec 20 21:24:24 2007 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #!/usr/bin/perl -w
2  ###############################################################################  ###############################################################################
3  #   Meteor  #   Meteor
4  #   An HTTP server for the 2.0 web  #   An HTTP server for the 2.0 web
5  #   Copyright (c) 2006 contributing authors  #   Copyright (c) 2006 contributing authors
6  #  #
7  #   Subscriber.pm  #   Subscriber.pm
8  #  #
9  #       Description:  #       Description:
10  #       Meteor Configuration handling.  #       Meteor Configuration handling.
11  #  #
12  #       Main program should call Meteor::Config::setCommandLineParameters(@ARGV),.  #       Main program should call Meteor::Config::setCommandLineParameters(@ARGV),.
13  #       Afterwards anybody can access $::CONF{<parameterName>}, where  #       Afterwards anybody can access $::CONF{<parameterName>}, where
14  #       <parameterName> is any valid parameter (except 'Help') listed in the  #       <parameterName> is any valid parameter (except 'Help') listed in the
15  #       @DEFAULTS array below.  #       @DEFAULTS array below.
16  #  #
17  ###############################################################################  ###############################################################################
18  #  #
19  #   This program is free software; you can redistribute it and/or modify it  #   This program is free software; you can redistribute it and/or modify it
20  #   under the terms of the GNU General Public License as published by the Free  #   under the terms of the GNU General Public License as published by the Free
21  #   Software Foundation; either version 2 of the License, or (at your option)  #   Software Foundation; either version 2 of the License, or (at your option)
22  #   any later version.  #   any later version.
23  #  #
24  #   This program is distributed in the hope that it will be useful, but WITHOUT  #   This program is distributed in the hope that it will be useful, but WITHOUT
25  #   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or  #   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
26  #   FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for  #   FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
27  #   more details.  #   more details.
28  #  #
29  #   You should have received a copy of the GNU General Public License along  #   You should have received a copy of the GNU General Public License along
30  #   with this program; if not, write to the Free Software Foundation, Inc.,  #   with this program; if not, write to the Free Software Foundation, Inc.,
31  #   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA  #   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
32  #  #
33  #   For more information visit www.meteorserver.org  #   For more information visit www.meteorserver.org
34  #  #
35  ###############################################################################  ###############################################################################
36    
37  package Meteor::Config;  package Meteor::Config;
38  ###############################################################################  ###############################################################################
39  # Configuration  # Configuration
40  ###############################################################################  ###############################################################################
41                    
42          use strict;          use strict;
43                    
44          our @DEFAULTS=(          our @DEFAULTS=(
45  'Configuration file location on disk (if any)',  'Configuration file location on disk (if any)',
46          ConfigFileLocation              => '/etc/meteord.conf',          ConfigFileLocation              => '/etc/meteord.conf',
47    
48  'IP address for controller server (leave empty for all local addresses)',  'IP address for controller server (leave empty for all local addresses)',
49          ControllerIP                    => '',          ControllerIP                    => '',
50    
51  'Port number for controller connections',  'Port number for controller connections',
52          ControllerPort                  => 4671,          ControllerPort                  => 4671,
53    
54  'Controller Shutdown message, sent when the controller server shuts down (leave empty for no message)',  'Controller Shutdown message, sent when the controller server shuts down (leave empty for no message)',
55          ControllerShutdownMsg   => '',          ControllerShutdownMsg   => '',
56    
57  'Debug Flag, when set daemon will run in foreground and emit debug messages',  'Debug Flag, when set daemon will run in foreground and emit debug messages',
58          Debug                                   => 0,          Debug                                   => 0,
59                    
60  'Name of index file to serve when a directory is requested from the static file web server',  'Name of index file to serve when a directory is requested from the static file web server',
61          DirectoryIndex  => 'index.html',          DirectoryIndex  => 'index.html',
62    
63  'Header to be served with static documents. ~server~ and ~status~ will be replaced by the appropriate values',  'Header template, ~server~, ~servertime~ and ~status~ will be replaced by the appropriate values.  **NOTE**: It is possible to define more than one HeaderTemplate by appending a number at the end, for example *HeaderTemplate42*. Clients can request a specific header to be used by adding the parameter template=<number> to their GET request. If *HeaderTemplate<number>* is not found, the system will use the default HeaderTemplate (no number)',
64          DocumentHeaderTemplate                  => 'HTTP/1.1 ~status~\r\nServer: ~server~\r\nContent-Type: text/html; charset=utf-8\r\n\r\n',          HeaderTemplate                  => 'HTTP/1.1 ~status~\r\nServer: ~server~\r\nContent-Type: text/html; charset=utf-8\r\nPragma: no-cache\r\nCache-Control: no-cache, no-store, must-revalidate\r\nExpires: Thu, 1 Jan 1970 00:00:00 GMT\r\n\r\n<html><head><meta http-equiv="Content-Type" content="text/html; charset=utf-8">\r\n<meta http-equiv="Cache-Control" content="no-store">\r\n<meta http-equiv="Cache-Control" content="no-cache">\r\n<meta http-equiv="Pragma" content="no-cache">\r\n<meta http-equiv="Expires" content="Thu, 1 Jan 1970 00:00:00 GMT">\r\n<script type="text/javascript">\r\nwindow.onError = null;\r\nvar domainparts = document.domain.split(".");\r\ndocument.domain = domainparts[domainparts.length-2]+"."+domainparts[domainparts.length-1];\r\nparent.Meteor.register(this);\r\n</script>\r\n</head>\r\n<body onload="try { parent.Meteor.reset(this) } catch (e) {}">\r\n',
65    
66  'Header template, ~server~, ~servertime~ and ~status~ will be replaced by the appropriate values.  **NOTE**: It is possible to define more than one HeaderTemplate by appending a number at the end, for example *HeaderTemplate42*. Clients can request a specific header to be used by adding the parameter template=<number> to their GET request. If *HeaderTemplate<number>* is not found, the system will use the default HeaderTemplate (no number)',  'Print out this help message',
67          HeaderTemplate                  => 'HTTP/1.1 ~status~\r\nServer: ~server~\r\nContent-Type: text/html; charset=utf-8\r\nPragma: no-cache\r\nCache-Control: no-cache, no-store, must-revalidate\r\nExpires: Thu, 1 Jan 1970 00:00:00 GMT\r\n\r\n<html><head><meta http-equiv="Content-Type" content="text/html; charset=utf-8">\r\n<meta http-equiv="Cache-Control" content="no-store">\r\n<meta http-equiv="Cache-Control" content="no-cache">\r\n<meta http-equiv="Pragma" content="no-cache">\r\n<meta http-equiv="Expires" content="Thu, 1 Jan 1970 00:00:00 GMT">\r\n<script type="text/javascript">\r\nwindow.onError = null;\r\nvar domainparts = document.domain.split(".");\r\ndocument.domain = domainparts[domainparts.length-2]+"."+domainparts[domainparts.length-1];\r\nparent.Meteor.register(this);\r\nparent.Meteor.setServerTime(~servertime~);\r\n</script>\r\n</head>\r\n<body onload="r()">\r\n',          Help                                    => '',
68    
69  'Print out this help message',  'Maximum age of a message in seconds',
70          Help                                    => '',          MaxMessageAge                   => 7200,
71    
72  'Maximum age of a message in seconds',  'Maximum number of messages to send to a subscriber before forcing their connection to close. Use 0 to disable',
73          MaxMessageAge                   => 7200,          MaxMessages                             => 0,
74    
75  'Maximum number of messages to send to a subscriber before forcing their connection to close. Use 0 to disable',  'Maximum number of stored messages per channel',
76          MaxMessages                             => 0,          MaxMessagesPerChannel   => 250,
77    
78  'Maximum number of stored messages per channel',  'Maximum duration in seconds for a subscriber connection to exist before forcing a it to close. Note that the server checks for expired connections in 60 second intervals, so small changes to this value will not have much of an effect. Use 0 to disable',
79          MaxMessagesPerChannel   => 250,          MaxTime                                 => 0,
80    
81  'Maximum duration in seconds for a subscriber connection to exist before forcing a it to close. Note that the server checks for expired connections in 60 second intervals, so small changes to this value will not have much of an effect. Use 0 to disable',  'Message template, ~text~, ~id~, ~channel~ and ~timestamp~ will be replaced by the appropriate values',
82          MaxTime                                 => 0,          MessageTemplate                 => '<script>p(~id~,"~channel~","~text~");</script>\r\n',
83    
84  'Message template, ~text~, ~id~ and ~timestamp~ will be replaced by the appropriate values',  'Interval at which PingMessage is sent to all persistent and identified subscriber connections (ie those including id=someuniqueidentifier in their request, and not specifying persist=0). Must be at least 3 if set higher than zero. Set to zero to disable.',
85          MessageTemplate                 => '<script>p(~id~,"~text~");</script>\r\n',          PingInterval                    => 5,
86    
87  'Interval at which PingMessage is sent to all persistent and identified subscriber connections (ie those including id=someuniqueidentifier in their request, and not specifying persist=0). Must be at least 3 if set higher than zero. Set to zero to disable.',  'Message to be sent to all persistent and identified subscriber connections (see above) every PingInterval seconds',
88          PingInterval                    => 5,          PingMessage                             => '<script>p(-1,"");</script>\r\n',
89    
90  'Message to be sent to all persistent and identified subscriber connections (see above) every PingInterval seconds',  'IP address for subscriber server (leave empty for all local addresses)',
91          PingMessage                             => '<script>p(-1,"");</script>\r\n',          SubscriberIP                    => '',
92    
93  'IP address for subscriber server (leave empty for all local addresses)',  'Port number for subscriber connections',
94          SubscriberIP                    => '',          SubscriberPort                  => 4670,
95    
96  'Port number for subscriber connections',  'Subscriber Shutdown message, sent when the subscriber server shuts down (leave empty for no message)',
97          SubscriberPort                  => 4670,          SubscriberShutdownMsg           => '<script>eof();</script>\r\n',
98    
99  'Subscriber Shutdown message, sent when the subscriber server shuts down (leave empty for no message)',  'An absolute filesystem path, to be used as the document root for Meteor\'s static file web server. If left empty, no documents will be served.',
100          SubscriberShutdownMsg           => '<script>eof();</script>\r\n',          SubscriberDocumentRoot  => '/usr/local/meteor/public_html',
101    
102  'An absolute filesystem path, to be used as the document root for Meteor\'s static file web server. If left empty, no documents will be served.',  'Since Meteor is capable of serving static pages from a document root as well as streaming events to subscribers, this paramter is used to specify the URI at which the event server can be reached. If set to the root, Meteor will lose the ability to serve static pages.',
103          SubscriberDocumentRoot  => '/usr/local/meteor/public_html',          SubscriberDynamicPageAddress    => '/push',
104    
105  'Since Meteor is capable of serving static pages from a document root as well as streaming events to subscribers, this paramter is used to specify the URI at which the event server can be reached. If set to the root, Meteor will lose the ability to serve static pages.',  'The syslog facility to use',
106          SubscriberDynamicPageAddress    => '/push',          SyslogFacility                  => 'daemon',
107            );
108  'The syslog facility to use',          
109          SyslogFacility                  => 'daemon',          our %ConfigFileData=();
110          );          our %CommandLine=();
111                    our %Defaults=();
112          our %ConfigFileData=();          our %ExtraKeys=();
113          our %CommandLine=();          
114          our %Defaults=();          for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)
115          our %ExtraKeys=();          {
116                            $Defaults{$DEFAULTS[$i+1]}=$DEFAULTS[$i+2];
117          for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)          }
118          {  
119                  $Defaults{$DEFAULTS[$i+1]}=$DEFAULTS[$i+2];  ###############################################################################
120          }  # Class methods
121    ###############################################################################
122  ###############################################################################  sub updateConfig {
123  # Class methods          my $class=shift;
124  ###############################################################################          
125  sub updateConfig {          %::CONF=();
126          my $class=shift;          
127                    my $debug=$class->valueForKey('Debug');
128          %::CONF=();          
129                    print STDERR '-'x79 ."\nParamters:\nSource \tName and Value\n".'-'x79 ."\n" if($debug);
130          my $debug=$class->valueForKey('Debug');          
131                    my @keys=();
132          print STDERR '-'x79 ."\nParamters:\nSource \tName and Value\n".'-'x79 ."\n" if($debug);          
133                    for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)
134          my @keys=();          {
135                            next if($DEFAULTS[$i+1] eq 'Help');
136          for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)                  push(@keys,$DEFAULTS[$i+1]);
137          {          }
138                  next if($DEFAULTS[$i+1] eq 'Help');          push(@keys,keys %ExtraKeys);
139                  push(@keys,$DEFAULTS[$i+1]);          
140          }          foreach my $key (@keys)
141          push(@keys,keys %ExtraKeys);          {              
142                            if(exists($CommandLine{$key}))
143          foreach my $key (@keys)                  {
144          {                                        print STDERR "CmdLine" if($debug);
145                  if(exists($CommandLine{$key}))                          $::CONF{$key}=$CommandLine{$key};
146                  {                  }
147                          print STDERR "CmdLine" if($debug);                  elsif(exists($ConfigFileData{$key}))
148                          $::CONF{$key}=$CommandLine{$key};                  {
149                  }                          print STDERR "CnfFile" if($debug);
150                  elsif(exists($ConfigFileData{$key}))                          $::CONF{$key}=$ConfigFileData{$key};
151                  {                  }
152                          print STDERR "CnfFile" if($debug);                  elsif(exists($Defaults{$key}))
153                          $::CONF{$key}=$ConfigFileData{$key};                  {
154                  }                          print STDERR "Default" if($debug);
155                  elsif(exists($Defaults{$key}))                          $::CONF{$key}=$Defaults{$key};
156                  {                  }
157                          print STDERR "Default" if($debug);                  
158                          $::CONF{$key}=$Defaults{$key};                  print STDERR "\t$key\t$::CONF{$key}\n" if($debug);
159                  }                  
160                                    # Take care of escapes
161                  print STDERR "\t$key\t$::CONF{$key}\n" if($debug);                  $::CONF{$key}=~s/\\(.)/
162                                            if($1 eq 'r')
163                  # Take care of escapes                          {
164                  $::CONF{$key}=~s/\\(.)/                                  "\r";
165                          if($1 eq 'r')                          }
166                          {                          elsif($1 eq 'n')
167                                  "\r";                          {
168                          }                                  "\n";
169                          elsif($1 eq 'n')                          }
170                          {                          elsif($1 eq 's')
171                                  "\n";                          {
172                          }                                  ' ';
173                          elsif($1 eq 's')                          }
174                          {                          elsif($1 eq 't')
175                                  ' ';                          {
176                          }                                  "\t";
177                          elsif($1 eq 't')                          }
178                          {                          else
179                                  "\t";                          {
180                          }                                  $1;
181                          else                          }
182                          {                  /gex;
183                                  $1;          }
184                          }          
185                  /gex;          print STDERR '-'x79 ."\n" if($debug);
186          }  }
187            
188          print STDERR '-'x79 ."\n" if($debug);  sub valueForKey {
189  }          my $class=shift;
190            my $key=shift;
191  sub valueForKey {          
192          my $class=shift;          return $CommandLine{$key} if(exists($CommandLine{$key}));
193          my $key=shift;          return $ConfigFileData{$key} if(exists($ConfigFileData{$key}));
194                    
195          return $CommandLine{$key} if(exists($CommandLine{$key}));          $Defaults{$key};
196          return $ConfigFileData{$key} if(exists($ConfigFileData{$key}));  }
197            
198          $Defaults{$key};  sub setCommandLineParameters {
199  }          my $class=shift;
200            
201  sub setCommandLineParameters {          while(my $cnt=scalar(@_))
202          my $class=shift;          {
203                            my $k=shift(@_);
204          while(my $cnt=scalar(@_))                  &usage("'$k' invalid") unless($k=~s/^\-(?=.+)//);
205          {                  
206                  my $k=shift(@_);                  $k='Debug' if($k eq 'd');
207                  &usage("'$k' invalid") unless($k=~s/^\-(?=.+)//);                  
208                                    my $key=undef;
209                  $k='Debug' if($k eq 'd');                  my $kl=length($k);
210                                    my $kOrig=$k;
211                  my $key=undef;                  $k=lc($k);
212                  my $kl=length($k);                  
213                  my $kOrig=$k;                  for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)
214                  $k=lc($k);                  {
215                                            my $p=$DEFAULTS[$i+1];
216                  for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)                          my $pl=length($p);
217                  {                          
218                          my $p=$DEFAULTS[$i+1];                          next if($kl>$pl);
219                          my $pl=length($p);                          
220                                                    #print "$kl $pl $k $p\n";
221                          next if($kl>$pl);                          
222                                                    if($kl==$pl && $k eq lc($p))
223                          #print "$kl $pl $k $p\n";                          {
224                                                            $key=$p;
225                          if($kl==$pl && $k eq lc($p))                                  last;
226                          {                          }
227                                  $key=$p;                          
228                                  last;                          my $ps=lc(substr($p,0,$kl));
229                          }                          
230                                                    if($k eq $ps)
231                          my $ps=lc(substr($p,0,$kl));                          {
232                                                            if(defined($key))
233                          if($k eq $ps)                                  {
234                          {                                          &usage("Ambigous parameter name '$kOrig'");
235                                  if(defined($key))                                  }
236                                  {                                  $key=$p;
237                                          &usage("Ambigous parameter name '$kOrig'");                          }
238                                  }                  }
239                                  $key=$p;                  
240                          }                  if($k=~/^HeaderTemplate(\d+)$/i)
241                  }                  {
242                                            $key="HeaderTemplate$1";
243                  if($k=~/^HeaderTemplate(\d+)$/i)                          $ExtraKeys{$key}=1;
244                  {                  }
245                          $key="HeaderTemplate$1";                          
246                          $ExtraKeys{$key}=1;                  &usage("Unknown parameter name '$kOrig'") unless(defined($key));
247                  }                  
248                                            &usage() if($key eq 'Help');
249                  &usage("Unknown parameter name '$kOrig'") unless(defined($key));                  
250                                    #print "$kOrig: $key\n";
251                  &usage() if($key eq 'Help');                  
252                                    $CommandLine{$key}=1;
253                  #print "$kOrig: $key\n";                  
254                                    if($cnt>1 && $_[0]!~/^\-(?!\-)/)
255                  $CommandLine{$key}=1;                  {
256                                            my $param=shift;
257                  if($cnt>1 && $_[0]!~/^\-(?!\-)/)                          $param=~s/^\-\-/\-/;
258                  {                          $CommandLine{$key}=$param;
259                          my $param=shift;                  }
260                          $param=~s/^\-\-/\-/;          }
261                          $CommandLine{$key}=$param;          
262                  }          $class->readConfig();
263          }          
264                    $class->updateConfig();
265          $class->readConfig();  }
266            
267          $class->updateConfig();  sub readConfig {
268  }          my $class=shift;
269            
270  sub readConfig {          %ConfigFileData=();
271          my $class=shift;          
272                    my $path=$class->valueForKey('ConfigFileLocation');
273          %ConfigFileData=();          return unless(defined($path) && -f $path);
274                    
275          my $path=$class->valueForKey('ConfigFileLocation');          open(CONFIG,"$path") or &usage("Config file '$path' for read: $!\n");
276          return unless(defined($path) && -f $path);          while(<CONFIG>)
277                    {
278          open(CONFIG,"$path") or &usage("Config file '$path' for read: $!\n");                  next if(/^\s*#/);
279          while(<CONFIG>)                  next if(/^\s*$/);
280          {                  
281                  next if(/^\s*#/);                  s/[\r\n]*$//;
282                  next if(/^\s*$/);                  
283                                    unless(/^(\S+)\s*(.*)/)
284                  s/[\r\n]*$//;                  {
285                                            &usage("Invalid configuration file parameter line '$_'");
286                  unless(/^(\S+)\s*(.*)/)                  }
287                  {                  
288                          &usage("Invalid configuration file parameter line '$_'");                  my $key=$1;
289                  }                  my $val=$2;
290                                    $val='' unless(defined($val));
291                  my $key=$1;                  
292                  my $val=$2;                  if($key=~/^HeaderTemplate\d+$/)
293                  $val='' unless(defined($val));                  {
294                                            $ExtraKeys{$key}=1;
295                  if($key=~/^HeaderTemplate\d+$/)                  }
296                  {                  else
297                          $ExtraKeys{$key}=1;                  {
298                  }                          unless(exists($Defaults{$key}))
299                  else                          {
300                  {                                  &usage("Unknown configuration file parameter name '$key'");
301                          unless(exists($Defaults{$key}))                          }
302                          {                          if($key eq 'ConfigFileLocation')
303                                  &usage("Unknown configuration file parameter name '$key'");                          {
304                          }                                  &usage("'ConfigFileLocation' parameter not allowed in configuration file!");
305                          if($key eq 'ConfigFileLocation')                          }
306                          {                  }
307                                  &usage("'ConfigFileLocation' parameter not allowed in configuration file!");                  
308                          }                  $val=~s/^--/-/;
309                  }                  
310                                    $ConfigFileData{$key}=$val;
311                  $val=~s/^--/-/;          }
312                            close(CONFIG);
313                  $ConfigFileData{$key}=$val;  }
314          }  
315          close(CONFIG);  sub usage {
316  }          my $msg=shift || '';
317            
318  sub usage {          if($msg) {
319          my $msg=shift || '';                  print STDERR <<"EOT";
320            $msg;
321          if($msg) {  For further help type $::PGM -help
322                  print STDERR <<"EOT";  or consult docs at http://www.meteorserver.org/
323  $msg;  EOT
324  For further help type $::PGM -help  
325  or consult docs at http://www.meteorserver.org/          } else {
326  EOT  
327            
328          } else {                  print STDERR <<"EOT";
329    
330            Meteor server v1.0 (release date: 1 Dec 2006)
331                  print STDERR <<"EOT";  Licensed under the terms of the GNU General Public Licence (2.0)
332    
333  Meteor server v1.0 (release date: 1 Dec 2006)  Usage:
334  Licensed under the terms of the GNU General Public Licence (2.0)  
335            $::PGM [-parameter [value] [-parameter [value]...]]
336  Usage:  
337    Accepted command-line parameters:
338          $::PGM [-parameter [value] [-parameter [value]...]]  
339    EOT
340  Accepted command-line parameters:          
341                    for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)
342  EOT                  {
343                                    print STDERR "-$DEFAULTS[$i+1]\n$DEFAULTS[$i].\n\n";
344                  for(my $i=0;$i<scalar(@DEFAULTS);$i+=3)                  }
345                  {                  
346                          print STDERR "-$DEFAULTS[$i+1]\n$DEFAULTS[$i].\n\n";                  print STDERR <<"EOT";  
347                  }          
348                    Any of the parameters listed above can also be configured in the
349                  print STDERR <<"EOT";    configuration file. The default location for this file is:
350            
351  Any of the parameters listed above can also be configured in the          $Defaults{'ConfigFileLocation'}
352  configuration file. The default location for this file is:  
353    For more information and complete documentation, see the Meteor
354          $Defaults{'ConfigFileLocation'}  website at http://www.meteorserver.org/
355    EOT
356  For more information and complete documentation, see the Meteor  
357  website at http://www.meteorserver.org/          }
358  EOT          exit(1);
359    }
360          }  
361          exit(1);  1;
 }  
   
 1;  
362  ############################################################################EOF  ############################################################################EOF

Legend:
Removed from v.9  
changed lines
  Added in v.32

  ViewVC Help
Powered by ViewVC 1.1.26