File : src/aws-services-web_mail.adb
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2004 --
-- ACT-Europe --
-- --
-- Authors: Dmitriy Anisimkov - Pascal Obry --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- $Id: aws-services-web_mail.adb,v 1.3 2004/04/06 12:18:19 obry Exp $
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with AWS.Config;
with AWS.MIME;
with AWS.OS_Lib;
with AWS.Parameters;
with AWS.POP;
with AWS.Resources.Streams;
with AWS.Services.Transient_Pages;
with AWS.Session;
with AWS.SMTP.Client;
with AWS.Templates;
with AWS.Messages;
with AWS.Utils;
package body AWS.Services.Web_Mail is
use Ada;
use Ada.Strings.Unbounded;
use AWS;
function Login (Request : in Status.Data) return Response.Data;
-- Get the login data from Request and returns the summary of the mailbox
function Summary (Request : in AWS.Status.Data) return AWS.Response.Data;
-- Returns a list of all messages in the mailbox
function Message (Request : in AWS.Status.Data) return AWS.Response.Data;
-- Returns a list of all messages in the mailbox
function Delete (Request : in AWS.Status.Data) return AWS.Response.Data;
-- Delete a message, returns to the summary page
function Reply (Request : in AWS.Status.Data) return AWS.Response.Data;
-- Returns a reply form
function Send (Request : in AWS.Status.Data) return AWS.Response.Data;
-- Send a message, used by the reply form above
--------------
-- Callback --
--------------
function Callback (Request : in AWS.Status.Data) return AWS.Response.Data is
WWW_Root : String renames AWS.Config.WWW_Root (Config.Get_Current);
WM_Session : constant Session.ID := Status.Session (Request);
URI : constant String := Status.URI (Request);
procedure Check_Session;
-- Checks current session data and set corresponding variables,
-- POP_Server is set to Null_Unbounded_String if no session data found.
SMTP_Server : Unbounded_String;
POP_Server : Unbounded_String;
User_Name : Unbounded_String;
Password : Unbounded_String;
-------------------
-- Check_Session --
-------------------
procedure Check_Session is
begin
if Session.Exist (WM_Session, "WM_POP_SERVER") then
SMTP_Server := To_Unbounded_String
(String'(Session.Get (WM_Session, "WM_SMTP_SERVER")));
POP_Server := To_Unbounded_String
(String'(Session.Get (WM_Session, "WM_POP_SERVER")));
User_Name := To_Unbounded_String
(String'(Session.Get (WM_Session, "WM_USER_NAME")));
Password := To_Unbounded_String
(String'(Session.Get (WM_Session, "WM_PASSWORD")));
end if;
end Check_Session;
begin
Check_Session;
if URI = "/wm_login" then
return Login (Request);
elsif URI = "/" or else POP_Server = Null_Unbounded_String then
return Response.File (MIME.Text_HTML, WWW_Root & "/wm_login.html");
elsif URI = "/wm_summary" then
return Summary (Request);
elsif URI = "/wm_message" then
return Message (Request);
elsif URI = "/wm_reply" then
return Reply (Request);
elsif URI = "/wm_delete" then
return Delete (Request);
elsif URI = "/wm_send" then
return Send (Request);
else
-- Check for a transient resource
declare
use type Resources.Streams.Stream_Access;
Stream : constant AWS.Resources.Streams.Stream_Access
:= Services.Transient_Pages.Get (URI);
begin
if Stream /= null then
return Response.Stream
(Status.Content_Type (Request),
Stream,
Server_Close => False);
else
-- This is not a known resource
if OS_Lib.Is_Regular_File (WWW_Root & "404.thtml") then
declare
Table : constant AWS.Templates.Translate_Table
:= (1 => Templates.Assoc ("PAGE", URI));
begin
-- Here we return the 404.thtml page if found. Note that
-- on Microsoft IE this page will be displayed only if
-- the total page size is bigger than 512 bytes or if it
-- includes at leat one image.
return Response.Acknowledge
(Messages.S404,
Templates.Parse (WWW_Root & "404.thtml", Table));
end;
else
return Response.Acknowledge
(Messages.S404,
"<p>Page '" & URI & "' Not found.");
end if;
end if;
end;
end if;
end Callback;
------------
-- Delete --
------------
function Delete (Request : in AWS.Status.Data) return AWS.Response.Data is
WM_Session : constant Session.ID := Status.Session (Request);
P_List : constant Parameters.List := Status.Parameters (Request);
POP_Server : constant String
:= Session.Get (WM_Session, "WM_POP_SERVER");
User_Name : constant String
:= Session.Get (WM_Session, "WM_USER_NAME");
Password : constant String
:= Session.Get (WM_Session, "WM_PASSWORD");
No_Message : constant Positive
:= Positive'Value (Parameters.Get (P_List, "NO_MESSAGE"));
Mailbox : POP.Mailbox;
begin
Mailbox := POP.Initialize (POP_Server, User_Name, Password);
POP.Delete (Mailbox, No_Message);
POP.Close (Mailbox);
return Response.URL ("/wm_summary");
end Delete;
-----------
-- Login --
-----------
function Login (Request : in Status.Data) return Response.Data is
WM_Session : constant Session.ID := Status.Session (Request);
P_List : constant Parameters.List := Status.Parameters (Request);
begin
Session.Set (WM_Session, "WM_SMTP_SERVER",
Parameters.Get (P_List, "WM_SMTP_SERVER"));
Session.Set (WM_Session, "WM_POP_SERVER",
Parameters.Get (P_List, "WM_POP_SERVER"));
Session.Set (WM_Session, "WM_USER_NAME",
Parameters.Get (P_List, "WM_USER_NAME"));
Session.Set (WM_Session, "WM_PASSWORD",
Parameters.Get (P_List, "WM_PASSWORD"));
return Response.URL ("/wm_summary");
end Login;
-------------
-- Message --
-------------
function Message (Request : in AWS.Status.Data) return AWS.Response.Data is
use type Templates.Translate_Table;
WWW_Root : String renames Config.WWW_Root (Config.Get_Current);
WM_Session : constant Session.ID := Status.Session (Request);
P_List : constant Parameters.List := Status.Parameters (Request);
POP_Server : constant String
:= Session.Get (WM_Session, "WM_POP_SERVER");
User_Name : constant String
:= Session.Get (WM_Session, "WM_USER_NAME");
Password : constant String
:= Session.Get (WM_Session, "WM_PASSWORD");
No_Message : constant Positive
:= Positive'Value (Parameters.Get (P_List, "NO_MESSAGE"));
Mailbox : POP.Mailbox;
Mess : POP.Message;
function Get_Content return Templates.Translate_Table;
-- Returns content and attachments
-----------------
-- Get_Content --
-----------------
function Get_Content return Templates.Translate_Table is
Content : Unbounded_String;
Att_Name : Templates.Vector_Tag;
Att_Ref : Templates.Vector_Tag;
procedure Add_Attachment
(Attachment : in POP.Attachment;
Index : in Positive;
Quit : in out Boolean);
-- Add new attachment data
--------------------
-- Add_Attachment --
--------------------
procedure Add_Attachment
(Attachment : in POP.Attachment;
Index : in Positive;
Quit : in out Boolean)
is
pragma Unreferenced (Index, Quit);
use type Templates.Vector_Tag;
begin
if POP.Is_File (Attachment) then
declare
Filename : constant String := POP.Filename (Attachment);
URI : constant String
:= Services.Transient_Pages.Get_URI & "/" & Filename;
-- We add the filename after the uniq URI to tell the
-- browser to use this name to save the file on disk.
begin
-- Add a reference to the attachment into the message body
Append (Content, ASCII.CR & ASCII.LF);
Append (Content, "<" & Filename & ">");
-- Add attachment data
Att_Name := Att_Name & Filename;
Att_Ref := Att_Ref & URI;
Services.Transient_Pages.Register
(URI,
POP.Content (Attachment),
Lifetime => 120.0);
end;
else
Append (Content, ASCII.CR & ASCII.LF);
Append (Content, Unbounded_String'(POP.Content (Attachment)));
end if;
end Add_Attachment;
---------------------------
-- Add_Every_Attachments --
---------------------------
procedure Add_Every_Attachment is
new POP.For_Every_Attachment (Add_Attachment);
begin
-- Add the message content
Content := POP.Content (Mess);
-- Analyse all attachments
Add_Every_Attachment (Mess);
-- Returns the corresponding translate table
return Templates.Translate_Table'
(Templates.Assoc ("WM_CONTENT", Content),
Templates.Assoc ("WM_ATT_NAME_V", Att_Name),
Templates.Assoc ("WM_ATT_REF_V", Att_Ref));
end Get_Content;
begin
Mailbox := POP.Initialize (POP_Server, User_Name, Password);
Mess := POP.Get (Mailbox, No_Message);
POP.Close (Mailbox);
return Response.Build
(MIME.Text_HTML,
Unbounded_String'
(Templates.Parse
(WWW_Root & "/wm_message.thtml",
Templates.Translate_Table'
(Templates.Assoc ("AWS_VERSION", AWS.Version),
Templates.Assoc ("WM_USER_NAME", User_Name),
Templates.Assoc ("WM_POP_SERVER", POP_Server),
Templates.Assoc
("WM_MESS_COUNT", POP.Message_Count (Mailbox)),
Templates.Assoc ("WM_MESSAGE", No_Message),
Templates.Assoc ("WM_SUBJECT", POP.Subject (Mess)),
Templates.Assoc ("WM_DATE", POP.Date (Mess)),
Templates.Assoc ("WM_FROM", POP.From (Mess)),
Templates.Assoc ("WM_CC", POP.CC (Mess)))
& Get_Content)));
end Message;
-----------
-- Reply --
-----------
function Reply (Request : in AWS.Status.Data) return AWS.Response.Data is
use type Templates.Translate_Table;
WWW_Root : String renames Config.WWW_Root (Config.Get_Current);
WM_Session : constant Session.ID := Status.Session (Request);
P_List : constant Parameters.List := Status.Parameters (Request);
SMTP_Server : constant String
:= Session.Get (WM_Session, "WM_SMTP_SERVER");
POP_Server : constant String
:= Session.Get (WM_Session, "WM_POP_SERVER");
User_Name : constant String
:= Session.Get (WM_Session, "WM_USER_NAME");
Password : constant String
:= Session.Get (WM_Session, "WM_PASSWORD");
No_Message : constant Positive
:= Positive'Value (Parameters.Get (P_List, "NO_MESSAGE"));
Mailbox : POP.Mailbox;
Mess : POP.Message;
function Get_Content return Templates.Translate_Table;
-- Returns content, all lines being prefixed
-----------------
-- Get_Content --
-----------------
function Get_Content return Templates.Translate_Table is
Prefix : constant String := "> ";
Content : Unbounded_String;
K : Positive := Prefix'Length + 1;
begin
-- Get message content
Content := POP.Content (Mess);
-- Prefix first line with "> "
Content := Prefix & Content;
-- Prefix every lines with "> "
while K < Length (Content) loop
if Element (Content, K) = ASCII.LF then
Insert (Content, K + 1, Prefix);
end if;
K := K + 1;
end loop;
return Templates.Translate_Table'
(1 => Templates.Assoc ("WM_CONTENT", Content));
end Get_Content;
begin
Mailbox := POP.Initialize (POP_Server, User_Name, Password);
Mess := POP.Get (Mailbox, No_Message);
POP.Close (Mailbox);
return Response.Build
(MIME.Text_HTML,
Unbounded_String'
(Templates.Parse
(WWW_Root & "/wm_reply.thtml",
Templates.Translate_Table'
(Templates.Assoc ("AWS_VERSION", AWS.Version),
Templates.Assoc ("WM_USER_NAME", User_Name),
Templates.Assoc ("WM_SMTP_SERVER", SMTP_Server),
Templates.Assoc ("WM_POP_SERVER", POP_Server),
Templates.Assoc
("WM_MESS_COUNT", POP.Message_Count (Mailbox)),
Templates.Assoc ("WM_MESSAGE", No_Message),
Templates.Assoc ("WM_SUBJECT", POP.Subject (Mess)),
Templates.Assoc ("WM_DATE", POP.Date (Mess)),
Templates.Assoc ("WM_FROM", POP.From (Mess)),
Templates.Assoc ("WM_CC", POP.CC (Mess)))
& Get_Content)));
end Reply;
----------
-- Send --
----------
function Send (Request : in AWS.Status.Data) return AWS.Response.Data is
WWW_Root : String renames Config.WWW_Root (Config.Get_Current);
WM_Session : constant Session.ID := Status.Session (Request);
P_List : constant Parameters.List := Status.Parameters (Request);
POP_Server : constant String
:= Session.Get (WM_Session, "WM_POP_SERVER");
SMTP_Server : constant String
:= Session.Get (WM_Session, "WM_SMTP_SERVER");
User_Name : constant String
:= Session.Get (WM_Session, "WM_USER_NAME");
function Get_From return SMTP.E_Mail_Data;
-- Build the From e-mail
--------------
-- Get_From --
--------------
function Get_From return SMTP.E_Mail_Data is
K : constant Natural := Strings.Fixed.Index (POP_Server, ".");
E_Mail : Unbounded_String;
begin
if K = 0 then
-- No domain specified, this is a local machine
E_Mail := To_Unbounded_String (User_Name & '@' & POP_Server);
else
-- Get the domain name after the first dot
E_Mail := To_Unbounded_String
(User_Name & '@' & POP_Server (K + 1 .. POP_Server'Last));
end if;
return SMTP.E_Mail (To_String (E_Mail), To_String (E_Mail));
end Get_From;
WM_SMTP : SMTP.Receiver;
Result : SMTP.Status;
begin
WM_SMTP := SMTP.Client.Initialize (SMTP_Server);
SMTP.Client.Send
(WM_SMTP,
From => Get_From,
To => SMTP.Parse (Parameters.Get (P_List, "WM_TO")),
Subject => Parameters.Get (P_List, "WM_SUBJECT"),
Message => Parameters.Get (P_List, "WM_CONTENT"),
Status => Result);
if SMTP.Is_Ok (Result) then
return Response.URL ("/wm_summary");
else
return Response.Build
(MIME.Text_HTML,
String'
(Templates.Parse
(WWW_Root & "/wm_error.thtml",
Templates.Translate_Table'
(1 => Templates.Assoc
("ERROR_MESSAGE", SMTP.Status_Message (Result))))));
end if;
exception
when Constraint_Error =>
return Response.Build
(MIME.Text_HTML,
String'
(Templates.Parse
(WWW_Root & "/wm_error.thtml",
Templates.Translate_Table'
(1 => Templates.Assoc
("ERROR_MESSAGE", "Can't parse e-mail")))));
end Send;
-------------
-- Summary --
-------------
function Summary (Request : in AWS.Status.Data) return AWS.Response.Data is
WWW_Root : String renames Config.WWW_Root (Config.Get_Current);
WM_Session : constant Session.ID := Status.Session (Request);
POP_Server : constant String
:= Session.Get (WM_Session, "WM_POP_SERVER");
User_Name : constant String
:= Session.Get (WM_Session, "WM_USER_NAME");
Password : constant String
:= Session.Get (WM_Session, "WM_PASSWORD");
procedure Add_Message
(Message : in POP.Message;
Index : in Positive;
Quit : in out Boolean);
-- Add message information into the vertor tags
Index_V : Templates.Vector_Tag;
Size_V : Templates.Vector_Tag;
Date_V : Templates.Vector_Tag;
From_V : Templates.Vector_Tag;
Subject_V : Templates.Vector_Tag;
-----------------
-- Add_Message --
-----------------
procedure Add_Message
(Message : in POP.Message;
Index : in Positive;
Quit : in out Boolean)
is
pragma Unreferenced (Quit);
use type Templates.Vector_Tag;
begin
Index_V := Utils.Image (Index) & Index_V;
Size_V := POP.Size (Message) & Size_V;
Date_V := POP.Date (Message) & Date_V;
From_V := POP.From (Message) & From_V;
Subject_V := POP.Subject (Message) & Subject_V;
end Add_Message;
-------------------------
-- Add_Message_Headers --
-------------------------
procedure Add_Message_Headers is
new POP.For_Every_Message_Header (Add_Message);
Mailbox : POP.Mailbox;
begin
Mailbox := POP.Initialize (POP_Server, User_Name, Password);
Add_Message_Headers (Mailbox);
POP.Close (Mailbox);
return Response.Build
(MIME.Text_HTML,
Unbounded_String'
(Templates.Parse
(WWW_Root & "/wm_summary.thtml",
Templates.Translate_Table'
(Templates.Assoc ("AWS_VERSION", AWS.Version),
Templates.Assoc
("WM_MESS_COUNT", POP.Message_Count (Mailbox)),
Templates.Assoc ("WM_MAILBOX_SIZE", POP.Size (Mailbox)),
Templates.Assoc ("WM_MESSAGE_V", Index_V),
Templates.Assoc ("WM_SIZE_V", Size_V),
Templates.Assoc ("WM_FROM_V", From_V),
Templates.Assoc ("WM_DATE_V", Date_V),
Templates.Assoc ("WM_SUBJECT_V", Subject_V),
Templates.Assoc ("WM_USER_NAME", User_Name),
Templates.Assoc ("WM_POP_SERVER", POP_Server)))));
end Summary;
end AWS.Services.Web_Mail;