samples/samp-form.cgi

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use CGI;
   4 use HTML::Entities;
   5
   6 my $cgi = CGI->new;
   7
   8 # get our parameter, make sure it's defined to avoid
   9 my $color = $cgi->param('color');
  10
  11 # Imager allows a number of different color specs, but keep this
  12 # simple, only accept simple RRGGBB hex colors
  13 my %errors;
  14
  15 if (defined $color && $color !~ /^[0-9a-f]{6}$/i) {
  16   $errors{color} = "Color must be hex RRGGBB";
  17 }
  18
  19 # validated, make it defined to avoid warnings in the HTML generation
  20 defined $color or $color = '';
  21
  22 # print the content type header and the start of out HTML
  23 print "Content-Type: text/html\n\n", <<HTML;
  24 <html>
  25   <head>
  26     <title>Sample HTML and Image generation with Imager</title>
  27   </head>
  28   <body>
  29     <form action="/cgi-bin/samp-form.cgi">
  30 HTML
  31
  32 # link to the image if we got a good color
  33 # START LINK GENERATION (see the POD)
  34 if ($color && !keys %errors) {
  35   # since color only contains word characters it doesn't need to be
  36   # escaped, in most cases you'd load URI::Escape and call uri_escape() on it
  37   print <<HTML;
  38 <img src="/cgi-bin/samp-image.cgi?color=$color" width="40" height="40" alt="color sample" />
  39 HTML
  40 }
  41 # END LINK GENERATION
  42
  43 # finish off the page
  44 # one reason template systems are handy...
  45 my $color_encoded = encode_entities($color);
  46 my $color_msg_encoded = encode_entities($errors{color} || '');
  47
  48 print <<HTML;
  49 <p>Color: <input type="text" name="color" value="$color_encoded" size="6" />
  50 $color_msg_encoded</p>
  51 <input type="submit" value="Show Color" />
  52 </html>
  53 </body>
  54 HTML
  55
  56 =head1 NAME
  57
  58 samp-form.cgi - demonstrates interaction of HTML generation with image generation
  59
  60 =head1 SYNOPSIS
  61
  62   /cgi-bin/samp-form.cgi?color=RRGGBB
  63
  64 =head1 DESCRIPTION
  65
  66 This is the HTML side of a sample for Imager that demonstrates
  67 generating an image linked from a HTML form.
  68
  69 See samp-image.cgi for the image generation side of this sample.
  70
  71 One common mistake seen in generating images is attempting to generate
  72 the image inline, for example:
  73
  74   # DON'T DO THIS, IT'S WRONG
  75   my $img = Imager->new(...);
  76   ...  draw on the image  ...
  77   print '<img src="',$img->write(fd=>fileno(STDOUT), type="jpeg"),'" />';
  78
  79 This sample code demonstrates one of the possible correct ways to
  80 generate an image linked from a HTML page.
  81
  82 This has the limitation that some processing is done twice, for
  83 example, the validation of the parameters, but it's good when the same
  84 image will never be generated again.
  85
  86 The basic approach is to have one program generate the HTML which
  87 links to a second program that generates the image.
  88
  89 This sample is only intended to demonstrate embedding a generated
  90 image in a page, it's missing some best practice:
  91
  92 =over
  93
  94 =item *
  95
  96 a templating system, like HTML::Mason, or Template::Toolkit should be
  97 used to generate the HTML, so that the HTML can be maintained
  98 separately from the code.  Such a system should also be able to HTML
  99 or URI escape values embedded in the page to avoid the separate code
 100 used above.
 101
 102 =item *
 103
 104 a more complex system would probably do some validation as part of
 105 business rules, in a module.
 106
 107 =back
 108
 109 =head1 ANOTHER APPROACH
 110
 111 A different way of doing this is to have the HTML generation script
 112 write the images to a directory under the web server document root,
 113 for example, the code from C<# START LINK GENERATION> to C<# END LINK
 114 # GENERATION> in samp-form.cgi would be replaced with something like:
 115
 116   if ($color && !keys %errors) {
 117     # make a fairly unique filename
 118     # in this case we could also use:
 119     #   my $filename = lc($color) . ".jpg";
 120     # but that's not a general solution
 121     use Time::HiRes;
 122     my $filename = time . $$ . ".jpg";
 123     my $image_path = $docroot . "/images/dynamic/" . $filename;
 124     my $image_url = "/images/dynamic/" . $filename;
 125
 126     my $im = Imager->new(xsize=>40, ysize=>40);
 127     $im->box(filled=>1, color=>$color);
 128
 129     $im->write(file=>$image_path)
 130       or die "Cannot write to $image_path:", $im->errstr, "\n";
 131
 132     print <<HTML;
 133   <img src="$image_url" width="40" height="40" alt="color sample" />
 134   HTML
 135   }
 136
 137 This has the advantage that you aren't handling a second potentially
 138 expensive CGI request to generate the image, but it means you need
 139 some mechanism to manage the files (for example, a cron job to delete
 140 old files), and you need to make some directory under the document
 141 root writable by the user that your web server runs CGI programs as,
 142 which may be a security concern.
 143
 144 Also, if you're generating large numbers of large images, you may end
 145 up using significant disk space.
 146
 147 =head1 SECURITY
 148
 149 It's important to remember that any value supplied by the user can be
 150 abused by the user, in this example there's only one parameter, the
 151 color of the sample image, but in a real application the values
 152 supplied coule include font filenames, URLs, image filename and so on.
 153 It's important that these are validated and in some cases limited to
 154 prevent a user from using your program to obtain access or deny access
 155 to things they shouldn't be able to.
 156
 157 For example of limiting a parameter, you might have a select like:
 158
 159   <!-- don't do this, it's wrong -->
 160   <select name="font">
 161     <option value="arial.ttf">Arial</option>
 162     <option value="arialb.ttf">Arial Black</option>
 163     ...
 164   </select>
 165
 166 and then build a font filename with:
 167
 168   my $fontname = $cgi->param('font');
 169   my $fontfile=$fontpath . $fontname;
 170
 171 but watch out when the user manually supplies font with a value like
 172 C<../../../some_file_that_crashes_freetype>.
 173
 174 So limit the values and validate them:
 175
 176   <select name="font">
 177     <option value="arial">Arial</option>
 178     <option value="arialb">Arial Bold</option>
 179     ...
 180   </select>
 181
 182 and code like:
 183
 184   my $fontname = $cgi->param('font');
 185   $fontname =~ /^\w+$/ or $fontname = 'arial'; # use a default if invalid
 186   -e $fontpath . $fontname . ".ttf" or $fontname = 'arial';
 187   my $fontfile = $fontpath . $fontname . '.ttf';
 188
 189 or use a lookup table:
 190
 191   my %fonts = (
 192     arial => "arial.ttf",
 193     arialb => "arialb.ttf",
 194     xfont_helv => "x11/helv.pfb",
 195     );
 196   ...
 197
 198   my $fontname = $cgi->param('font');
 199   exists $fonts{$fontname} or $fontname = 'arial';
 200   my $fontfile = $fontpath . $fonts{$fontname};
 201
 202 Remember that with perl your code isn't in a sandbox, it's up to you
 203 to prevent shooting yourself in the foot.
 204
 205 =head1 AUTHOR
 206
 207 Tony Cook <tony@develop-help.com>
 208
 209 =cut