#!/usr/local/bin/perl
# index.cgi - perl script to handle autodiscovery for email
# d. stoddard - 2019-11-16 - accelix llc
#
# The only parameter recognized for this process is email=address, where address
# is a valid email address.  The program returns a valid XML response for the
# email configuration autodiscovery process.
#
# This handles either POST or GET based transactions.
#
# How This Works
# --------------
# Autodiscovery requires a fixed path for retrieving XML configuration data.
# While it would be nice to use a static XML file for this, the file needs to
# be modified to contain the email address if it was passed as a parameter.
# The way to do this is to make the name of the XML file a directory and to
# place an index.cgi file inside the directory to receive the parameter and
# return the required XML. Read the links in the References section for more\
# information.
#
# References
# ----------
# Info on Auto Discovery:
# https://docs.microsoft.com/en-us/previous-versions/office/office-2010/cc511507(v=office.14)
# https://support.combell.com/en/how-to-configure-autodiscover-for-basic-mail/751
# http://forum.directadmin.com/showthread.php?t=58483
# https://docs.iredmail.org/iredmail-easy.autoconfig.autodiscover.html
# https://virtualmin.com/node/52609
# http://www.zytrax.com/books/dns/ch8/srv.html
#
# Info on DNS SRV Records:
# http://www.zytrax.com/books/dns/ch8/srv.html
#
# CNAME Record Examples for BIND DNS:
# _autodiscover._tcp.transfig.org. 3600 SRV 1 1 443 autodiscover.transfig.org.
# _pop3s._tcp.transfig.org.	3600 SRV 1 1 995 pop.transfig.org.
# _imaps._tcp.transfig.org.	3600 SRV 1 1 993 imap.transfig.org.
# _submission._tcp.transfig.org.	3600 SRV 1 1 587 smtp.transfig.org.
#
# ; these are normally CNAME entries to the server
# autodiscover.transfig.org.	3600 A	209.183.228.220
# autoconfig.transfig.org.	3600 A	209.183.228.220
#
use strict;
use warnings;
# use diagnostics;
 
# add support for utf8 characters
use open ':std', ':utf8';
use open IO => ':bytes';

# load perl modules
use CGI;
use CGI::Carp qw(fatalsToBrowser);

# configuration elements

# common elements
our %fm		= ();			# hash of input data from form
our %msg	= ();			# hash for sending message
our $data	= "";			# data result
our $error	= "";			# error text value
our $time	= localtime;		# current date and time (ctime3)
our $sep	= chr(1);		# field separator (control-a)
our $x		= "";			# loop iteration variable
our $email	= "";			# email address

# function prototypes
sub ReadForm ();			# read data from form
sub SendResponse ();			# send XML to requestor
sub RemoveScripts ($);			# remove embedded html form scripts
sub Redirect ($);			# redirect to another page

###
###  START PROGRAM
###

# read the form
%fm = ReadForm ();

# get the email address
$email = $fm{email} if (exists $fm{email});

# send response
print "Content-Type: application/xml\n\n";
SendResponse ();
exit 0;

### END PROGRAM ###

 
###
###  ReadForm() reads the values from an HTML form and converts the data on
###  the form to its appropriate internal representation.
###
 
sub
ReadForm () {
  my %form	= ();			# form element hash
  my @list	= ();			# list of field names
  my @vals	= ();			# list of field values
  my $q		= "";			# query handle
  my $i		= 0;			# form field index
  my $rcnt	= 0;			# read count
  my $size	= 0;			# upload file size
  my $pcnt	= 0;			# parameter count for PATH_INFO
  my $buf	= "";			# read buffer
  my $key	= "";			# field name
  my $val	= "";			# field value
 
  # get the form object
  $q = new CGI;

  # reject POST response so we can read GET parameters
  if ($ENV{REQUEST_METHOD} eq "POST") {
    print $q->header (
      -type   => "application/xml",
      -status => "405 Method Not Allowed"
    );
    SendResponse ();
    exit 0;
  }

  # get a list of key and value items
  @list = $q->param();
 
  # retrieve all of the field=value parameters
  foreach $i (@list) {
    $key  = $i;
    @vals = $q->param($i);
 
    # handle multiple values
    foreach $val (@vals) {
 
      # eliminate cross-site scripting hacks
      $key = RemoveScripts ($key);
      $val = RemoveScripts ($val);
 
      # append fields with binary zero separator
      $form{$key} .= "$sep" if (exists $form{$key});
      $form{$key} .= $val;
    }
  }
 
  # check for path info
  if (exists $ENV{PATH_INFO}) {
    @vals = split (/\//,$ENV{PATH_INFO});
    foreach (@vals) {
      if ($_) {
        ++$pcnt;
        $key        = "_${pcnt}";
        $form{$key} = $_;
      }
    }
  }
 
  return %form;
}

 
###
###  SendResponse() is responsible for sending the XML response to the
###  requestor.
###

sub
SendResponse () {
  # send response
  print <<"EOF";
<?xml version="1.0" encoding="utf-8" ?>
<Autodiscover xmlns="http://schemas.microsoft.com/exchange/autodiscover/responseschema/2006">
<Response xmlns="http://schemas.microsoft.com/exchange/autodiscover/outlook/responseschema/2006a">
<Account>
  <AccountType>email</AccountType>
  <Action>settings</Action>
  <Protocol>
    <Type>POP3</Type>
    <Server>mail.transfig.org</Server>
    <Port>995</Port>
    <DomainRequired>off</DomainRequired>
    <SPA>off</SPA>
    <SSL>on</SSL>
    <AuthRequired>on</AuthRequired>
  </Protocol>
  <Protocol>
    <Type>IMAP</Type>
    <Server>mail.transfig.org</Server>
    <Port>993</Port>
    <DomainRequired>off</DomainRequired>
    <SPA>off</SPA>
    <SSL>on</SSL>
    <AuthRequired>on</AuthRequired>
  </Protocol>
  <Protocol>
    <Type>SMTP</Type>
    <Server>mail.transfig.org</Server>
    <Port>587</Port>
    <DomainRequired>off</DomainRequired>
    <SPA>off</SPA>
    <Encryption>tls</Encryption>
    <AuthRequired>on</AuthRequired>
    <UsePOPAuth>on</UsePOPAuth>
    <SMTPLast>on</SMTPLast>
  </Protocol>
</Account>
</Response>
</Autodiscover>
EOF

  return 1;
}


###
###  RemoveScripts() will remove HTML scripts from form data, preventing
###  possible cross-site scripting attacks.
###
 
sub
RemoveScripts ($) {
  my $item	= shift;		# item to be edited
 
  # remove client-side scripts
  $item =~ s/(<[\s\/]*)(script\b[^>]*>)/$1x$2/gi;
 
  # remove HTML tags
  while ($item =~ s/(<[^>]*?)\b(on\w+\s*=)/$1x$2/gi) {}
 
  return $item;
}
 
 
###
###  The Redirect() function is responsible for redirecting the web client to
###  another URL.  This can be useful for sending someone to another page,
###  setting the value of one or more cookies, or forcing the browser into
###  secure mode.  The routine uses one parameter -- the url to redirect
###  the web client to.
###
 
sub
Redirect ($) {
  my $url = shift;			# get the location to redirect to
  print "Location: $url\n";
  print "Content-type: text/html; charset=utf-8\n\n";
  return 1;
}