site/cgi-bin/modules/BSE/UI/Affiliate.pm

   1 package BSE::UI::Affiliate;
   2 use strict;
   3 use base qw(BSE::UI::Dispatch);
   4 use BSE::Util::Tags qw(tag_hash);
   5 use DevHelp::HTML;
   6
   7 my %actions =
   8   (
   9    set => 1,
  10    set2 => 1,
  11    show => 1,
  12    none => 1,
  13   );
  14
  15 sub actions { \%actions }
  16
  17 sub default_action { 'show' }
  18
  19 =head1 NAME
  20
  21 BSE::UI::Affiliate - set the affiliate code for new orders or display a user info page
  22
  23 =head1 SYNOPSIS
  24
  25 # display a user's information or affiliate page
  26
  27 http://your.site.com/cgi-bin/affiliate.pl?id=I<number>
  28
  29 # set the stored affiliate code and refresh to the top of the site
  30
  31 http://your.site.com/cgi-bin/affiliate.pl?a_set=1&id=I<code>
  32
  33 # set the stored affiliate code and refresh to I<url>
  34
  35 http://your.site.com/cgi-bin/affiliate.pl?a_set=1&id=I<code>&r=I<url>
  36
  37 =head1 DESCRIPTION
  38
  39 This is the implementation of L<affiliate.pl>.
  40
  41 =head1 TARGETS
  42
  43 =over
  44
  45 =item a_set
  46
  47 This is called to set the affiliate code.
  48
  49 Requires that an C<id> parameter be supplied with the affiliate code
  50 which is stored in the user session.  This is then stored in the order
  51 record if the user creates an order before the cookie expires.  This
  52 id can be any string, it need not be a user on the current site.
  53
  54 Optionally, you can supply a C<r> parameter which will be refreshed to
  55 after the affiliate code is set.  If this is not supplied there will
  56 be a refresh to either C<default_refresh> in C<[affiliate]> in
  57 C<bse.cfg> or to the top of the site.
  58
  59 If your site url and site secureurl are different then there will be
  60 an intermediate refresh to C<a_set2> to set the affiliate code on the
  61 other side of the site.  C<a_set2> will then refresh to your supplied
  62 C<r> parameter or its default.
  63
  64 You can also configure which referer header values are permitted in
  65 bse.cfg.  See L<config/[affiliate]> for more information.
  66
  67 =cut
  68
  69 sub req_set {
  70   my ($class, $req) = @_;
  71
  72   my $cgi = $req->cgi;
  73   my $cfg = $req->cfg;
  74   my $id = $cgi->param('id');
  75
  76   defined($id) && $id =~ /^\w+$/
  77     or return $class->req_none($req, "Missing or invalid id");
  78
  79   my $allowed_referer = $cfg->entry('affiliate', 'allowed_referer');
  80   my $require_referer = $cfg->entry('affiliate', 'require_referer');
  81   if ($allowed_referer) {
  82     my @allowed = split /;/, $allowed_referer;
  83     my $referer = $ENV{HTTP_REFERER};
  84     if ($referer) {
  85       my ($domain) = ($referer =~ m!^\w+://([\w/]+)!);
  86       $domain = lc $domain;
  87       my $found = 0;
  88       for my $entry (@allowed) {
  89         $entry = lc $entry;
  90
  91         if (length($entry) <= length($domain) &&
  92             $entry eq substr($domain, -length($entry))) {
  93           ++$found;
  94           last;
  95         }
  96       }
  97       $found
  98         or return $class->req_none($req, "$referer not in the permitted list of referers");
  99     }
 100     else {
 101       $require_referer
 102         and return $class->req_none($req, 'Referer not supplied');
 103     }
 104   }
 105
 106   my $url = $cgi->param('r');
 107   $url ||= $cfg->entry('affiliate', 'default_refresh');
 108   $url ||= $cfg->entryVar('site', 'url');
 109
 110   $req->session->{affiliate_code} = $id;
 111
 112   # set it on the other side too, if needed
 113   my $baseurl = $cfg->entryVar('site', 'url');
 114   my $securl = $cfg->entryVar('site', 'secureurl');
 115
 116   if ($baseurl eq $securl) {
 117     return BSE::Template->get_refresh($url, $cfg);
 118   }
 119   else {
 120     # which host are we on?
 121     # first get info about the 2 possible hosts
 122     my ($baseprot, $basehost, $baseport) =
 123       $baseurl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
 124     $baseport ||= $baseprot eq 'http' ? 80 : 443;
 125
 126     # get info about the current host
 127     my $port = $ENV{SERVER_PORT} || 80;
 128     my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
 129     my $protocol = $ishttps ? 'https' : 'http';
 130
 131     my $onbase = 1;
 132     if (lc $ENV{SERVER_NAME} ne lc $basehost
 133        || lc $protocol ne $baseprot
 134        || $baseport != $port) {
 135       print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n";
 136       $onbase = 0;
 137     }
 138
 139     my $setter = $onbase ? $securl : $baseurl;
 140     $setter .= "$ENV{SCRIPT_NAME}?a_set2=1&id=".escape_uri($id);
 141     $setter .= "&r=".escape_uri($url);
 142     return BSE::Template->get_refresh($setter, $cfg);
 143   }
 144 }
 145
 146 =item a_set2
 147
 148 Sets the affiliate code for the "other" side of the site.
 149
 150 This should only be linked to by the C<a_set> target.
 151
 152 This does no referer checks.
 153
 154 =cut
 155
 156 # yes, this completely removes any point of the referer checks, but
 157 # since referer checks aren't a security issue anyway, it doesn't
 158 # matter
 159
 160 sub req_set2 {
 161   my ($class, $req) = @_;
 162
 163   my $cgi = $req->cgi;
 164   my $cfg = $req->cfg;
 165   my $id = $cgi->param('id');
 166
 167   defined($id) && $id =~ /^\w+$/
 168     or return $class->req_none($req, "Missing or invalid id");
 169
 170   $req->session->{affiliate_code} = $id;
 171
 172   my $url = $cgi->param('r');
 173   $url ||= $cfg->entry('affiliate', 'default_refresh');
 174   $url ||= $cfg->entryVar('site', 'url');
 175
 176   return BSE::Template->get_refresh($url, $cfg);
 177 }
 178
 179 =item a_show
 180
 181 Display the affiliate page based on a user id number.
 182
 183 This is the default target, so you do not need to supply a target
 184 parameter.
 185
 186 The page is displayed based on the C<affiliate.tmpl> template.
 187
 188 The basic user side tags are available, as well as the C<siteuser> tag
 189 which gives access to the site user's record.
 190
 191 Be careful about which information you display.
 192
 193 =cut
 194
 195 sub req_show {
 196   my ($class, $req) = @_;
 197
 198   my $cgi = $req->cgi;
 199   my $cfg = $req->cfg;
 200
 201   my $id = $cgi->param('id');
 202   defined $id
 203     or return $class->req_none($req, "No identifier supplied");
 204   require SiteUsers;
 205   my $user = SiteUsers->getByPkey($id);
 206   $user
 207     or return $class->req_none($req, "Unknown user");
 208 #  require BSE::TB::Subscriptions;
 209 #   my $subid = $cfg->entry('affiliate', 'subscription_required');
 210 #   if ($subid) {
 211 #     my $sub = BSE::TB::Subscriptions->getByPkey($subid)
 212 #       || BSE::TB::Subscriptions->getBy(text_id => $subid)
 213 #       or return $class->req_none($req, "Configuration error: Unknown subscription id");
 214 #   }
 215
 216   my %acts;
 217   %acts =
 218     (
 219      BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
 220      siteuser => [ \&tag_hash, $user ],
 221     );
 222
 223   return $req->dyn_response('affiliate', \%acts);
 224 }
 225
 226 sub req_none {
 227   my ($class, $req, $msg) = @_;
 228
 229   print STDERR "Something went wrong: $msg\n" if $msg;
 230
 231   # just refresh to the home page
 232   my $url = $req->cfg->entry('site', 'url');
 233   return BSE::Template->get_refresh($url, $req->cfg);
 234 }
 235
 236 =back
 237
 238 =head1 AUTHOR
 239
 240 Tony Cook <tony@develop-help.com>
 241
 242 =cut
 243
 244
 245 1;