Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
freebsd
GitHub Repository: freebsd/freebsd-doc
 Path: blob/main/website/content/en/cgi/cgi-lib.pl
18093 views
1
#!/usr/bin/perl -- -*- C -*-

2
# Perl Routines to Manipulate CGI input

3
# [email protected]

4
#

5
# Copyright 1994 Steven E. Brenner  

6
# Unpublished work.

7
# Permission granted to use and modify this library so long as the

8
# copyright above is maintained, modifications are documented, and

9
# credit is given for any use of the library.

10
#

11
# Thanks are due to many people for reporting bugs and suggestions

12
# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,

13
# Andrew Dalke, Mark-Jason Dominus and Dave Dittrich.

14
# For more information, see:

15
#     http://www.bio.cam.ac.uk/web/form.html       

16
#     http://www.seas.upenn.edu/~mengwong/forms/   

17
# Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi):

18
#

19
# require "cgi-lib.pl";

20
# if (&ReadParse(*input)) {

21
#    print &PrintHeader, &PrintVariables(%input);

22
# } else {

23
#   print &PrintHeader,'<form><input type="submit">Data: <input name="myfield">';

24
#}

25
# ReadParse

26
# Reads in GET or POST data, converts it to unescaped text, and puts

27
# one key=value in each member of the list "@in"

28
# Also creates key/value pairs in %in, using '\0' to separate multiple

29
# selections

30
# Returns TRUE if there was input, FALSE if there was no input 

31
# UNDEF may be used in the future to indicate some failure.

32
# Now that cgi scripts can be put in the normal file space, it is useful

33
# to combine both the form and the script in one place.  If no parameters

34
# are given (i.e., ReadParse returns FALSE), then a form could be output.

35
# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,

36
# information is stored there, rather than in $in, @in, and %in.

37
#

38


39
sub ReadParse {

40
  local (*in) = @_ if @_;

41
  local ($i, $key, $val);

42
  # Read in text

43
  if (&MethGet) {

44
    $in = $ENV{'QUERY_STRING'};

45
  } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {

46
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});

47
  }

48
  @in = split(/&/,$in);

49
  foreach $i (0 .. $#in) {

50
    # Convert plus's to spaces

51
    $in[$i] =~ s/\+/ /g;

52
    # Split into key and value.  

53
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

54
    # Convert %XX from hex numbers to alphanumeric

55
    $key =~ s/%(..)/pack("c",hex($1))/ge;

56
    $key =~ tr/[^A-Za-z0-9\-\_\$\+\=\~\.\,]//;		# allow only safe chars

57
    $val =~ s/%(..)/pack("c",hex($1))/ge;

58
    $val =~ tr/[^A-Za-z0-9\-\_\$\+\=\~\.\,]//;		# allow only safe chars

59
    # Associate key and value

60
    $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator

61
    $in{$key} .= $val;

62
  }

63
  return length($in); 

64
}

65
# PrintHeader

66
# Returns the magic line which tells WWW that we're an HTML document

67
sub PrintHeader {

68
  return "Content-type: text/html\n\n";

69
}

70
# MethGet

71
# Return true if this cgi call was using the GET request, false otherwise

72
sub MethGet {

73
  return ($ENV{'REQUEST_METHOD'} eq "GET");

74
}

75
# MyURL

76
# Returns a URL to the script

77
sub MyURL  {

78
  return  '//' . $ENV{'SERVER_NAME'} .  $ENV{'SCRIPT_NAME'};

79
}

80
# CgiError

81
# Prints out an error message which containes appropriate headers,

82
# markup, etcetera.

83
# Parameters:

84
#  If no parameters, gives a generic error message

85
#  Otherwise, the first parameter will be the title and the rest will 

86
#  be given as different paragraphs of the body

87
sub CgiError {

88
  local (@msg) = @_;

89
  local ($i,$name);

90
  if (!@msg) {

91
    $name = &MyURL;

92
    @msg = ("Error: script $name encountered fatal error");

93
  };

94
  print &PrintHeader;

95
  print "<html><head><title>$msg[0]</title></head>\n";

96
  print "<body><h1>$msg[0]</h1>\n";

97
  foreach $i (1 .. $#msg) {

98
    print "<p>$msg[$i]</p>\n";

99
  }

100
  print "</body></html>\n";

101
}

102
# PrintVariables

103
# Nicely formats variables in an associative array passed as a parameter

104
# And returns the HTML string.

105
sub PrintVariables {

106
  local (%in) = @_;

107
  local ($old, $out, $output);

108
  #$old = $*;  $* =1;

109
  $output .=  "<DL COMPACT>";

110
  foreach $key (sort keys(%in)) {

111
    foreach (split("\0", $in{$key})) {

112
      ($out = $_) =~ s/\n/<BR>/gm;

113
      $output .=  "<DT><B>$key</B><DD><I>$out</I><BR>";

114
    }

115
  }

116
  $output .=  "</DL>";

117
  #$* = $old;

118
  return $output;

119
}

120
1;

121


122