0.15_08 commit r0_15_08
authorTony Cook <tony@develop-help.com>
Wed, 6 Apr 2005 02:29:39 +0000 (02:29 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Wed, 6 Apr 2005 02:29:39 +0000 (02:29 +0000)
15 files changed:
Makefile
localinst.perl
schema/bse.sql
site/cgi-bin/modules/BSE/Cfg.pm
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/UI/Formmail.pm
site/cgi-bin/modules/BSE/UserReg.pm
site/cgi-bin/modules/DevHelp/Payments/SecurePay.pm [new file with mode: 0644]
site/cgi-bin/modules/DevHelp/Validate.pm
site/docs/bse.pod
site/docs/formmail.pod
site/templates/formmail/defemail.tmpl
site/templates/formmail/defquery_base.tmpl
test.cfg

index cad01e3..a9188c0 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-VERSION=0.15_07
+VERSION=0.15_08
 DISTNAME=bse-$(VERSION)
 DISTBUILD=$(DISTNAME)
 DISTTAR=../$(DISTNAME).tar
index b6a2661..29e0e5d 100644 (file)
@@ -93,7 +93,7 @@ open TESTCONF, "< $conffile"
   or die "Could not open config file $conffile: $!";
 while (<TESTCONF>) {
   chomp;
-  /^\s*(\w[^=]*\w)\.(\w+)\s*=\s*(.*\S)\s*$/ or next;
+  /^\s*(\w[^=]*\w)\.(\w+)\s*=\s*(.*)\s*$/ or next;
   $conf{lc $1}{lc $2} = $3;
 }
 
index 2cdf6e1..51f4787 100644 (file)
@@ -23,7 +23,7 @@ CREATE TABLE article (
   imagePos char(2) not null,
   release datetime DEFAULT '0000-00-00 00:00:00' NOT NULL,
   expire datetime DEFAULT '9999-12-31 23:59:59' NOT NULL,
-  keyword varchar(255),
+  keyword varchar(255) not null default '',
 
   -- the template in $TMPLDIR used to generate this as HTML
   template varchar(127) DEFAULT '' NOT NULL,
index 1265b89..fe22bc9 100644 (file)
@@ -110,6 +110,45 @@ sub entriesCS {
   return;
 }
 
+=item order($section)
+
+Returns a list of keys for the given section.
+
+This can contain duplicates, since included config files may also set
+a given key.
+
+=cut
+
+sub order {
+  my ($self, $section) = @_;
+
+  if ($self->{config}{lc $section}) {
+    return @{$self->{config}{lc $section}{order}};
+  }
+
+  return;
+}
+
+=item orderCS($section)
+
+Returns a list of keys for the given section.  The keys are returned
+in their original case.
+
+This can contain duplicates, since included config files may also set
+a given key.
+
+=cut
+
+sub orderCS {
+  my ($self, $section) = @_;
+
+  if ($self->{config}{lc $section}) {
+    return @{$self->{config}{lc $section}{order_nc}};
+  }
+
+  return;
+}
+
 =item entryErr($section, $key)
 
 Same as the entry() method, except that it dies if the key or section
@@ -262,7 +301,9 @@ sub _load_cfg {
     }
     elsif (/^\s*([^=\s]+)\s*=\s*(.*)$/) {
       $section or next;
+      push @{$sections{$section}{order}}, lc $1;
       $sections{$section}{values}{lc $1} = $2;
+      push @{$sections{$section}{order_nc}}, $1;
       $sections{$section}{case}{$1} = $2;
     }
   }
@@ -309,7 +350,9 @@ sub _load_cfg {
        }
        elsif (/^\s*([^=\s]+)\s*=\s*(.*)$/) {
          $section or next;
+         push @{$sections{$section}{order}}, lc $1;
          $sections{$section}{values}{lc $1} = $2;
+         push @{$sections{$section}{order_nc}}, $1;
          $sections{$section}{case}{$1} = $2;
        }
       }
index 94c7744..a20f569 100644 (file)
@@ -311,7 +311,7 @@ SQL
 select od.id, od.userId, od.orderDate, od.siteuser_id, 
     sum(oi.subscription_period * oi.units) as "subscription_period"
   from orders od, order_item oi
-  where oi.subscription_id = ? and od.id = oi.orderId
+  where oi.subscription_id = ? and od.id = oi.orderId and od.complete <> 0
   group by od.id, od.userId, od.orderDate, od.siteuser_id
   order by od.orderDate desc
 SQL
@@ -337,6 +337,7 @@ select od.orderDate,
   od.id as "order_id", oi.id as "item_id", oi.productId as "product_id"
   from orders od, order_item oi
   where oi.subscription_id = ? and od.id = oi.orderId and od.siteuser_id = ?
+        and od.complete <> 0
 SQL
    userSubscribedEntry => <<SQL,
 select * from bse_user_subscribed 
index 4c3ce67..aa6acce 100644 (file)
@@ -2688,7 +2688,7 @@ sub default_value {
   $col eq 'release' and return now_sqldate();
 
   if ($col eq 'threshold') {
-    my $parent = $article->{parentid} != -1 
+    my $parent = defined $article->{parentid} && $article->{parentid} != -1 
       && Articles->getByPkey($article->{parentid}); 
 
     $parent and return $parent->{threshold};
index beaf381..f144340 100644 (file)
@@ -2,7 +2,7 @@ package BSE::UI::Formmail;
 use strict;
 use base qw(BSE::UI::Dispatch);
 use BSE::Util::Tags qw(tag_hash tag_error_img);
-use DevHelp::HTML;
+use DevHelp::HTML qw(:default popup_menu);
 use DevHelp::Validate qw(dh_validate dh_configure_fields);
 use BSE::Util::Iterate;
 use constant DISPLAY_TIMEOUT => 300;
@@ -34,9 +34,15 @@ my %form_defs =
    mail => 'formmail/defemail',
    fields => 'from,subject,text',
    subject => 'User form emailed',
+   encrypt => 0,
+   crypt_class => $Constants::SHOP_CRYPTO,
+   crypt_gpg => $Constants::SHOP_GPG,
+   crypt_pgpe => $Constants::SHOP_PGPE,
+   crypt_pgp => $Constants::SHOP_PGP,
+   crypt_passphrase => $Constants::SHOP_PASSPHRASE,
+   crypt_signing_id => $Constants::SHOP_SIGNING_ID,
   );
 
-
 sub _get_form {
   my ($req) = @_;
 
@@ -74,6 +80,77 @@ sub _get_form {
   \%form;
 }
 
+sub _get_field {
+  my ($form, $rcurrent_field, $args, $acts, $templater) = @_;
+
+  my $field;
+  if ($args =~ /\S/) {
+    my ($name) = DevHelp::Tags->get_parms($args, $acts, $templater);
+    if ($name) {
+      ($field) = $form->{validation}{$name};
+      unless ($field) {
+       print STDERR "Field name '$name' (from '$args') not found for values iterator\n";
+       return;
+      }
+    }
+    else {
+      print STDERR "Could not extract a field name from '$args' for values iterator\n";
+      return;
+    }
+  }
+  else {
+    $field = $$rcurrent_field;
+    unless (defined $field) {
+      print STDERR "No current field for values iterator\n";
+      return;
+    }
+  }
+
+  return $field;
+}
+
+sub iter_values {
+  my ($form, $rcurrent_field, $args, $acts, $name, $templater) = @_;
+
+  my $field = _get_field($form, $rcurrent_field, $args, $acts, $templater)
+    or return;
+
+  defined $field->{values} or return;
+
+  return map +{ id => $_->[0], name => $_->[1] }, @{$field->{values}};
+}
+
+sub tag_values_select {
+  my ($form, $cgi, $rcurrent_field, $args, $acts, $name, $templater) = @_;
+
+  my $field = _get_field($form, $rcurrent_field, $args, $acts, $templater)
+    or return '** Could not get field **';
+
+  defined $field->{values} 
+    or return "** field $field->{name} has no values **";
+
+  my %labels = map @$_, @{$field->{values}};
+
+  my ($value) = $cgi->param($field->{name});
+  my @extras;
+  if (defined $value) {
+    push @extras, -default => $value;
+  }
+  
+  return popup_menu(-name => $field->{name},
+                   -values => [ map $_->[0], @{$field->{values}} ],
+                   -labels => \%labels,
+                   @extras);
+}
+
+sub tag_ifValueSet {
+  my ($cgi, $rcurrent_field, $rcurrent_value) = @_;
+
+  return 0 unless $$rcurrent_field && $$rcurrent_value;
+  my @values = $cgi->param($$rcurrent_field->{name});
+  return scalar(grep $_ eq $$rcurrent_value->{id}, @values);
+}
+
 sub req_show {
   my ($class, $req, $errors) = @_;
 
@@ -83,18 +160,44 @@ sub req_show {
 
   my $it = BSE::Util::Iterate->new;
   my %acts;
+  my $current_field;
+  my $current_value;
   %acts =
     (
      BSE::Util::Tags->basic(\%acts, $req->cgi, $req->cfg),
      error_img => [ \&tag_error_img, $req->cfg, $errors ],
-     $it->make_iterator(undef, 'field', 'fields', $form->{fields}),
+     $it->make_iterator(undef, 'field', 'fields', $form->{fields},
+                       undef, undef, \$current_field),
      msg => $msg,
      id => $form->{id},
+     $it->make_iterator([ \&iter_values, $form, \$current_field ],
+                       'value', 'values', undef, undef,
+                       'nocache', \$current_value),
+     values_select => 
+     [ \&tag_values_select, $form, $req->cgi, \$current_field ],
+     ifValueSet => 
+     [ \&tag_ifValueSet, $req->cgi, \$current_field, \$current_value ],
     );
 
   return $req->response($form->{query}, \%acts);
 }
 
+sub iter_cgi_values {
+  my ($form, $rcurrent_field, $args, $acts, $name, $templater) = @_;
+
+  my $field = _get_field($form, $rcurrent_field, $args, $acts, $templater)
+    or return;
+  
+  $field->{value_array} or return;
+
+  $field->{values} or
+    return map +{ id => $_, name => $_ }, @{$field->{value_array}};
+
+  my %poss_values = map { $_->[0] => $_->[1] } @{$field->{values}};
+
+  return map +{ id => $_, name => $poss_values{$_} }, @{$field->{value_array}};
+}
+
 sub req_send {
   my ($class, $req) = @_;
 
@@ -113,30 +216,43 @@ sub req_send {
 
   # grab our values
   my %values;
+  my %array_values;
   for my $field (@{$form->{fields}}) {
-    $field->{value} = $values{$field->{name}} = 
-      join '', $cgi->param($field->{name});
+    my $name = $field->{name};
+    my @values = $cgi->param($name);
+    $field->{value} = $values{$name} = "@values";
+    $field->{value_array} = $array_values{$name} = \@values;
   }
 
   # send an email
   my $user = $req->siteuser;
   my $it = BSE::Util::Iterate->new;
   my %acts;
+  my $current_field;
   %acts =
     (
      BSE::Util::Tags->static(\%acts, $cfg),
      ifUser=>!!$user,
      user => $user ? [ \&tag_hash, $user ] : '',
      value => [ \&tag_hash, \%values ],
-     $it->make_iterator(undef, 'field', 'fields', $form->{fields}),
+     $it->make_iterator(undef, 'field', 'fields', $form->{fields}, 
+                       undef, undef, \$current_field),
+     $it->make_iterator([ \&iter_cgi_values, $form, \$current_field ],
+                       'value', 'values', undef, undef, 'nocache'),
      id => $form->{id},
     );
 
   require BSE::Mail;
   my $mailer = BSE::Mail->new(cfg=>$cfg);
   my $content = BSE::Template->get_page($form->{mail}, $cfg, \%acts);
+  my @headers;
+  if ($form->{encrypt}) {
+    $content = $class->_encrypt($cfg, $form, $content);
+    push @headers, "Content-Type: application/pgp; format=text; x-action=encrypt\n";
+  }
   unless ($mailer->send(to=>$form->{email}, from=>$form->{email},
-                       subject=>$form->{subject}, body=>$content)) {
+                       subject=>$form->{subject}, body=>$content,
+                       headers => join('', @headers))) {
     print STDERR "Error sending mail: ", $mailer->errstr, "\n";
     $errors{_mail} = $mailer->{errstr};
     return $class->req_show($req, \%errors);
@@ -145,6 +261,7 @@ sub req_send {
   # make them available to the a_sent handler
   my $session = $req->session;
   $session->{formmail} = \%values;
+  $session->{formmail_array} = \%array_values;
   $session->{formmail_done} = time;
 
   my $url = $ENV{SCRIPT} . "?a_done=1&form=$form->{id}&t=".$session->{formmail_done};
@@ -186,4 +303,28 @@ sub req_done {
   return $req->response($form->{done}, \%acts);
 }
 
+sub _encrypt {
+  my ($class, $cfg, $form, $content) = @_;
+
+  (my $class_file = $form->{crypt_class}.".pm") =~ s!::!/!g;
+  require $class_file;
+  my $encryptor = $form->{crypt_class}->new;
+  my %opts =
+    (
+     passphrase => $form->{crypt_passphrase},
+     stripwarn => 1,
+     debug => $cfg->entry('debug', 'mail_encryption', 0),
+     sign => !!$form->{crypt_signing_id},
+     secretkeyid => $form->{crypt_signing_id},
+     pgp => $form->{crypt_pgp},
+     pgpe => $form->{crypt_pgpe},
+     gpg => $form->{crypt_gpg},
+    );
+
+  my $result = $encryptor->encrypt($form->{email}, $content, %opts)
+    or die "Cannot encrypt ",$encryptor->error;
+
+  $result;
+}
+
 1;
index 52376f7..9cbd539 100644 (file)
@@ -1104,11 +1104,18 @@ sub show_lost_password {
 
   $message ||= $cgi->param('message') || '';
   $message = escape_html($message);
+  my $userid = $session->{userid};
+  my $user;
+  if ($userid) {
+    $user = SiteUsers->getBy(userId=>$userid);
+  }
+
   my %acts;
   %acts =
     (
      BSE::Util::Tags->basic(\%acts, $cgi, $cfg),
      message => $message,
+     $self->user_tags(\%acts, $session, $user),
     );
   BSE::Template->show_page('user/lostpassword', $cfg, \%acts);
 }
diff --git a/site/cgi-bin/modules/DevHelp/Payments/SecurePay.pm b/site/cgi-bin/modules/DevHelp/Payments/SecurePay.pm
new file mode 100644 (file)
index 0000000..ad93f58
--- /dev/null
@@ -0,0 +1,170 @@
+package DevHelp::Payments::SecurePay;
+use strict;
+use Config;
+use Carp 'confess';
+
+sub new {
+  my ($class, $cfg) = @_;
+
+  my $debug = $cfg->entry('securepay', 'debug', 0);
+
+  # setup the environment
+  my $sep = $Config{path_sep};
+  for my $var (qw/CLASSPATH PATH LD_LIBRARY_PATH/) {
+    my $value = $cfg->entry("securepay", "\L$var");
+    if ($ENV{$var}) {
+      $ENV{$var} = $value . $sep . $ENV{$var};
+    }
+    else {
+      $ENV{$var} = $value;
+    }
+  }
+  my $java_port = $cfg->entry('securepay', 'java_port', 8765);
+  my $directory = $cfg->entryErr('securepay', 'java_directory');
+  my %args =
+    (
+     SHARED_JVM => 1,
+     PORT => $java_port,
+     DIRECTORY => $directory,
+    );
+  $args{CLASSPATH} = $cfg->entry("securepay", $ENV{CLASSPATH})
+    if $ENV{CLASSPATH};
+  $args{DEBUG} = $debug if $debug;
+  require Inline;
+  Inline->import
+       (
+        Java => 'STUDY',
+        STUDY => [ qw/securepay.jxa.api.Payment securepay.jxa.api.Txn/ ],
+       %args,
+       );
+  #use Data::Dumper;
+  #print Dumper \%BSE::SecurePay::securepay::jxa::api::Payment::;
+
+  my $test = $cfg->entry('securepay', 'test', 1);
+  my $livemerchantid = $cfg->entry('securepay', 'merchantid');
+  my $testmerchantid = $cfg->entry('securepay', 'testmerchantid');
+  my $testurl =  $cfg->entry('securepay', 'testperiodicurl', 
+                            "https://www.securepay.com.au/test/payment");
+  my $liveurl =  $cfg->entry('securepay', 'periodicurl',
+                            "https://www.securepay.com.au/xmlapi/payment");
+  my $timeout = $cfg->entry('securepay', 'timeout');
+  my $testpassword = $cfg->entry('securepay', 'testpassword');
+  my $livepassword = $cfg->entry('securepay', 'password');
+  my $poprefix = $cfg->entry('securepay', 'prefix', '');
+  if ($debug) {
+    print STDERR "SecurePay Config:\n",
+      "  test: $test\n  url: $testurl - $liveurl\n  merchantid: $testmerchantid - $livemerchantid\n  timeout:",
+       defined($timeout) ? $timeout : "undef", "\n  prefix: $poprefix\n";
+       
+  }
+  my $result_code = $cfg->entry('securepay', 'result_code');
+  return bless {
+               test => $test,
+               livemerchantid => $livemerchantid,
+               testmerchantid => $testmerchantid,
+               liveurl => $liveurl,
+               testurl => $testurl,
+               timeout => $timeout,
+               testpassword => $testpassword,
+               livepassword => $livepassword,
+               prefix => $poprefix,
+               debug => $debug,
+               result_code => $result_code,
+              }, $class;
+}
+
+sub payment {
+  my ($self, %args) = @_;
+
+  for my $name (qw/orderno amount cardnumber expirydate/) {
+    defined $args{$name}
+      or confess "Missing $name argument";
+  }
+
+  my $orderno = $self->{prefix} . $args{orderno};
+
+  my $amount = $args{amount};
+  if ($self->{test} && defined($self->{result_code})) {
+    $amount = 100 * int($amount / 100) + $self->{result_code};
+  }
+
+  if ($args{expirydate} =~ /^(\d\d\d\d)(\d\d)$/) {
+    $args{expirydate} = sprintf("%02d/%02d", $2, $1 %100);
+  }
+
+  my $if = $self->_interface($args{test});
+  my $txn = $if->addTxn(0, $orderno);
+  $txn->setTxnSource(0);
+  $txn->setAmount($amount);
+  $txn->setCardNumber($args{cardnumber});
+  $txn->setExpiryDate($args{expirydate});
+
+  my $test = $args{test} || $self->{test};
+  my $password = $test ? $self->{testpassword} : $self->{livepassword};
+  my $processed = $if->process($password);
+
+  if ($processed) {
+    my $resp = $if->getTxn(0);
+    if ($self->{debug}) {
+      print STDERR "Sent Status: ",$if->getStatusCode(),"\n";
+      print STDERR "Desc: ",$if->getStatusDesc(),"\n";
+    }
+    print STDERR "Approved: ",$resp->getApproved,"\n";
+    return 
+      {
+       success => $resp->getApproved,
+       statuscode => $resp->getResponseCode(),
+       error => $resp->getResponseText(),
+       receipt => $resp->getTxnId(),
+      };
+  }
+  else {
+    if ($self->{debug}) {
+      print STDERR "Fail Status: ",$if->getStatusCode(),"\n";
+      print STDERR "Desc: ",$if->getStatusDesc(),"\n";
+    }
+    return {
+           success => 0,
+           statuscode => $if->getStatusCode(),
+           error => $if->getStatusDesc(),
+          };
+  }
+}
+
+sub _interface {
+  my ($self, $test) = @_;
+
+  $test ||= $self->{test};
+  my $url = $test ? $self->{testurl} : $self->{liveurl};
+  print STDERR "URL: $url\n" if $self->{debug};
+  my $merchantid = $test ? $self->{testmerchantid} : $self->{livemerchantid};
+
+  print STDERR "MerchantID: $merchantid\n" if $self->{debug};
+  my $if = DevHelp::Payments::SecurePay::securepay::jxa::api::Payment->new;
+  $if->setMerchantId($merchantid);
+  $if->setServerURL($url);
+  $if->setProcessTimeout($self->{timeout}) if $self->{timeout};
+
+  $if;
+}
+
+
+
+1;
+
+=head1 NAME
+
+  BSE::SecurePay - the bottom level interface for talking to securepay.
+
+=head1 SYNOPSIS
+
+  my $secpay = BSE::SecurePay->new($cfg);
+  my $result = $secpay->payment(%parms);
+  $result = $secpay->preauth(%parms);
+  $result = $secpay->complete(%parms);
+
+=head1 DESCRIPTION
+
+There will be more here.
+
+=cut
index 3cfef3f..d455f5c 100644 (file)
@@ -433,6 +433,31 @@ sub _get_cfg_fields {
        $cfg_fields->{$field}{$cfg_name} = $value;
       }
     }
+
+    my $values = $cfg->entry($section, "${field}_values");
+    if (defined $values) {
+      my @values;
+      if ($values =~ /;/) {
+       for my $entry (split /;/, $values) {
+         if ($entry =~ /^([^=]+)=(.*)$/) {
+           push @values, [ $1, $2 ];
+         }
+         else {
+           push @values, [ $entry, $entry ];
+         }
+       }
+      }
+      else {
+       my %entries = $cfg->entriesCS($values);
+       my @order = $cfg->orderCS($values);
+
+       my %seen;
+       # we only want the last value in the order
+       @order = reverse grep !$seen{$_}++, reverse @order;
+       @values = map [ $_, $entries{$_} ], @order;
+      }
+      $cfg_fields->{$field}{values} = \@values;
+    }
   }
 }
 
index 39f5090..a5ca230 100644 (file)
@@ -10,6 +10,41 @@ Maybe I'll add some other bits here.
 
 =head1 CHANGES
 
+=head2 0.15_08
+
+=over
+
+=item *
+
+subscription calculations no longer include incomplete orders.
+
+=item *
+
+the user and ifUser tags are now available on the user/lostpassword
+template.
+
+=item *
+
+localinst.perl (used by make test, make testinst, make testfiles) no
+longer ignores empty config values.
+
+=item *
+
+the article keyword field now defaults to empty rather than NULL.
+
+=item *
+
+fmail.pl forms can now be select, multiselect, radio or check button
+fields.  The values can be specified in the config file.  See
+docs/formmail.pod for details.
+
+=item *
+
+the emails sent by fmail.pl can be sent encrypted or encrypted and
+signed.  See docs/formmail.pod for details.
+
+=back
+
 =head2 0.15_07
 
 This release adds a new column to the orders table.  You will need to
index 1fdee19..6c603a0 100644 (file)
@@ -130,6 +130,44 @@ subject - the subject of the email sent. Default: User form emailed
 email - the email address the form data is sent to.  Defaults to the
 value configured as [shop].from or $SHOP_FROM from Constants.pm
 
+=item *
+
+encrypt - if this is non-zero then the emailed form data is encrypted
+using PGP or GPG as configured (see the crypt options below).
+
+See L<ENCRYPTION> for more information.
+
+=item *
+
+crypt_class - the encryption class to use.  Default: value of
+$SHOP_CRYPTO from Constants.pm.  eg. Squirrel::GPG
+
+Note that the only encryption module that undergoes any testing is
+Squirrel::GPG.
+
+=item *
+
+crypt_gpg - the name of the gpg binary to use.  Default: value of
+$SHOP_GPG from Constants.pm.  Only used with the Squirrel::GPG module.
+eq. gpg
+
+=item *
+
+crypt_pgp - the name of the pgpe binary to use.  Default: value of
+$SHOP_PGP from Constants.pm.  Only used with the Squirrel::PGP5 and
+Squirrel::PGP6 modules.  eg. pgp
+
+=item *
+
+crypt_passphrase - the passphrase to the private key specified by
+crypt_signing_id.  Only required if the encrypted email is to be
+signed.  Default: $SHOP_PASSPHRASE from Constants.pm
+
+=item *
+
+crypt_signing_id - the key id to sign the encrypted message with.
+Default: $SHOP_SIGNING_ID from Constants.pm.  eg. 564EB128
+
 =back
 
 You can also configure information used for validation and available
@@ -167,19 +205,42 @@ also configure extra rules, with some limits.
 =item *
 
 I<fieldname>_htmltype - used by the default query form to choose how
-to display the field.  Values accepted are "textarea", "password", or
-"text".
+to display the field.  Values accepted are "textarea", "password",
+"text", "select", "multiselect", "radio", "check".
 
 =item *
 
-I<fieldtype>_width - used by the default query form to set the width
+I<fieldname>_width - used by the default query form to set the width
 attribute for text, password and textarea fields.
 
 =item *
 
-I<fieldtype>_height - used by the default query form to set the height
+I<fieldname>_height - used by the default query form to set the height
 attribute for textarea fields.
 
+=item *
+
+I<fieldname>_values - either the name of another configuration file
+section containing possible field values as keys and descriptions as
+values, or a semi-colon separated list of possible values.  For example:
+
+  [someform form]
+  ; shows as alpha, beta, gamma, selecting alpha returns a value of alpha
+  ; beta as beta, gamma as gamma
+  foo_values=alpha;beta;gamma
+  ; shows as alpha, beta, gamma, selecting alpha returns a, beta b, gamma c
+  bar_values=a=alpha;b=beta;c=gamma
+  ; shows as One,Two,Three, selecting One return 1, Two 2, Three 3
+  quux_values=Quux Values
+
+  [Quux values]
+  1=One
+  2=Two
+  3=Three
+
+This is used by the "select", "multiselect", "check" and "radio"
+htmltype values.
+
 =back
 
 =head1 TEMPLATES
@@ -271,6 +332,110 @@ user I<userfield> - access to the user's SiteUser record.
 
 =back
 
+=head1 ENCRYPTION
+
+From release 0.15_08 of BSE the emails sent to the configured form
+address can be encrypted and optionally signed.
+
+IT IS VERY IMPORTANT TO TEST A FORM IF ENCRYPTION IS ENABLED.  TEST
+ALL CHANGES TO THE ENCRYPTION CONFIGURATION.
+
+This is enabled by setting encrypt=1 in the [I<form> form]
+configuration file section.
+
+By default the same encryption settings as used for email will be
+used, but you can override these on a form basis.
+
+=head2 Setting up GnuPG
+
+To enable encryption of the email you must create a private key for
+the recipient of the email:
+
+  someuser$ gpg --gen-key
+
+and follow the prompts.
+
+Find the id of the key:
+
+  someuser$ gpg --list-keys
+  /home/someuser/.gnupg/pubring.gpg
+  -----------------------------
+  pub  1024D/FB26DB74 2005-04-06 Joseph Bloe <someuser@example.com>
+  sub  1024g/5CC8431C 2005-04-06 [expires: 2006-04-06]
+
+and then export it:
+
+  someuser$ gpg -a --export FB26DB74 >someuser.pubkey
+
+You then need to take that file to the web server and import it into
+the public key-ring of the user that the web server software runs as:
+
+  webuser$ gpg --import someuser.pubkey
+
+The simplest way to enable the key for use is to sign the key, since
+you may not want to make the signed key usable for others, you should
+lsign it:
+
+  webuser$ gpg --lsign-key FB26DB74
+
+If you want the emails to be signed you will need to reverse this
+process, ie. create a private key for webuser, export it, import it to
+someuser.
+
+=head2 Signing the email
+
+If you don't want the email signed, set crypt_signing_id to empty:
+
+  crypt_signing_id=
+
+If you do want the encrypted email signed you will need to set the
+signing id and the passphrase:
+
+  crypt_signing_id=5CC8431C
+  crypt_passphrase=passphrase for private key
+
+=head2 Troubleshooting
+
+Problems with the encryption setup can be difficult to debug.  Your
+first step should be to enable mail_encryption debugging:
+
+  [debug]
+  mail_encryption=1
+
+This will dump the HOME variable used, the gpg command used, and any
+output from GPG to stderr, which should then show in your web server
+error log.
+
+If you see problems, first try disabling signing.
+
+If you still have problems, try running the encryption command, but
+without the --no-tty command, providing some input.  For example, if
+you see:
+
+  GPG command: gpg -aqe -r 'tony@develop-help.com' --no-tty
+
+in the error log, try running:
+
+  echo something | gpg -aqe -r 'someuser@example.com'
+
+This should give you some idea of what's needed.  If you see:
+
+  Could not find a valid trust path to the key.  Let's see whether we
+  can assign some missing owner trust values.
+
+  No path leading to one of our keys found.
+
+  1024g/5CC8431C 2005-04-06 "Joseph Bloe <someuser@example.com>"
+             Fingerprint: 3F01 3589 BB4E 5D5B 9512  XXXX 063F DF74 5CC8 431C
+
+  It is NOT certain that the key belongs to its owner.
+  If you *really* know what you are doing, you may answer
+  the next question with yes
+
+  Use this key anyway?
+
+Then you need to lsign this key, as above in L<Setting up GnuPG>.
+
 =head1 AUTHOR
 
 Tony Cook <tony@develop-help.com>
index 9963d0d..003760c 100644 (file)
@@ -8,5 +8,8 @@ Email: <:user email:>
 :>
 <:iterator begin fields:>
 ** <:field description:> **
-  <:field value:>
-<:iterator end fields:>
+<:ifField values:><:iterator begin values
+:>  <:value id:>: <:value name:>
+<:iterator end values
+:><:or:>  <:field value:>
+<:eif:><:iterator end fields:>
index 2467229..80e0e1c 100644 (file)
   <textarea name="<:field name:>" <:ifField width:>cols="<:field width:>"<:or:><:eif:> <:ifField height:>rows="<:field height:>"<:or:><:eif:> wrap="virtual"><:old [field name]:></textarea>
   <:case Eq [field htmltype] "password":>
   <input type="password" name="<:field name:>" value="<:old [field name]:>" <:ifField width:>size="<:field width:>"<:or:><:eif:> />
+  <:case Eq [field htmltype] "select":>
+  <:values_select:>
+  <:case Eq [field htmltype] "multiselect":>
+  <select name="<:field name:>" multiple="multiple">
+  <:iterator begin values:>
+  <option value="<:value id:>"<:ifValueSet:> selected="selected"<:or:><:eif:>><:value name:></option>
+  <:iterator end values:>
+  </select>
+  <:case Eq [field htmltype] "radio":>
+  <:iterator begin values:>
+  <input type="radio" name="<:field name:>" value="<:value id:>"<:ifValueSet:> checked="checked"<:or:><:eif:> />&nbsp;<:value name:>
+  <:iterator separator values:>
+  <br />
+  <:iterator end values:>
+  <:case Eq [field htmltype] "check":>
+  <:iterator begin values:>
+  <input type="checkbox" name="<:field name:>" value="<:value id:>"<:ifValueSet:> checked="checked"<:or:><:eif:> />&nbsp;<:value name:>
+  <:iterator separator values:>
+  <br />
+  <:iterator end values:>
   <:case default:>
   <input type="text" name="<:field name:>" value="<:old [field name]:>" <:ifField width:>size="<:field width:>"<:or:><:eif:> />
   <:endswitch:>
index 66af458..6b9799a 100644 (file)
--- a/test.cfg
+++ b/test.cfg
@@ -45,6 +45,7 @@ site users.info_on_register=1
 site users.subscribe_1=1
 debug.cookies=0
 debug.logon_cookies=0
+debug.mail_encryption=1
 site users.billing_on_main_opts=0
 #site users.user_register=0
 #paths.libraries=/home/tony/dev/bse/tandb_dealer/cvs/modules
@@ -94,13 +95,33 @@ editor.thumbs_class=BSE::Thumb::Imager
 
 default formmail validation.subject_width=40
 
-test form.fields=name,company
+test form.fields=name,company,select,radio,check,multiselect
 test form.subject=Foo
+test form.encrypt=1
+test form.crypt_signing_id=7BA62838
+test form.crypt_passphrase=
+test form.email=tony@develop-help.com
 test formmail validation.name_description=Your Name
 test formmail validation.name_required=1
 test formmail validation.name_width=60
 test formmail validation.company_description=Organization
 test formmail validation.company_required=0
+test formmail validation.select_values=1=Hello;2=Goodbye;3=Arivaderchi
+test formmail validation.select_htmltype=select
+test formmail validation.radio_htmltype=radio
+test formmail validation.radio_values=Test Radio Values
+test formmail validation.check_htmltype=check
+test formmail validation.check_values=Test Check Values
+test formmail validation.multiselect_htmltype=multiselect
+test formmail validation.multiselect_values=test check values
+
+test radio values.first=One
+test radio values.second=Two
+test radio values.third=Three
+
+test check values.perl=Perl
+test check values.php=PHP
+test check values.cobol=COBOL
 
 site.secureadmin=1
 #article defaults.title=<set the article title>
@@ -110,9 +131,9 @@ site.secureadmin=1
 
 shop.cardprocessor=DevHelp::Payments::Test
 #shop.cardprocessor=DevHelp::Payments::Inpho
-inpho.user=theowww
-inpho.password=s1tz^^mD1
-inpho.test=1
-inpho.test_url=http://www.develop-help.com/cgi-bin/inphotest.pl
-inpho.test_user=test
-inpho.test_password=test
+#inpho.user=theowww
+#inpho.password=s1tz^^mD1
+#inpho.test=1
+#inpho.test_url=http://www.develop-help.com/cgi-bin/inphotest.pl
+#inpho.test_user=test
+#inpho.test_password=test