------------------------------------------------------------------------------ -- Ada Web Server -- -- -- -- Copyright (C) 2007-2012, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 3, 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. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are -- -- granted additional permissions described in the GCC Runtime Library -- -- Exception, version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- 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. -- ------------------------------------------------------------------------------ with Ada.Strings.Fixed; with AWS.Net.Buffered; with AWS.Translator; package body AWS.SMTP.Authentication.Plain is use Ada; ----------------- -- Before_Send -- ----------------- overriding procedure Before_Send (Credential : Plain.Credential; Sock : in out Net.Socket_Type'Class; Status : out SMTP.Status) is Answer : Server_Reply; begin Net.Buffered.Put_Line (Sock, "AUTH PLAIN " & Image (Credential)); Check_Answer (Sock, Answer); -- here we might get a request code to provide authentication data, or -- the usual Requested_Action_Ok. (If the credentials image in -- Server.Auth has been accepted along with the AUTH PLAIN ). if Answer.Code = Auth_Successful then null; elsif Answer.Code = Requested_Action_Ok then null; elsif Answer.Code = Provide_Watchword then Net.Buffered.Put_Line (Sock, Image (Credential)); Check_Answer (Sock, Answer); if Answer.Code /= Auth_Successful then Add (Answer, Status); end if; else Add (Answer, Status); end if; end Before_Send; ----------- -- Image -- ----------- overriding function Image (Info : Credential) return String is UTF_8_NUL : constant Character := Character'Val (0); -- Part of AUTH PLAIN message text, acting as a separator -- The message to be sent consists of parts as desribed in -- RFC4616, 2. PLAIN SASL mechanism, -- -- message = [authzid] UTF8NUL authcid UTF8NUL passwd -- -- Authzid is not used. Message : constant String := UTF_8_NUL & Info.Auth_Cid (1 .. Info.Last_A) & UTF_8_NUL & Info.Password (1 .. Info.Last_P); -- The Base64 Encode function expects a Stream_Element_Array. -- Assume that characters can safely be interpreted as stream -- elements and therefore use unchecked conversion. begin return Translator.Base64_Encode (Translator.To_Stream_Element_Array (Message)); end Image; ---------------- -- Initialize -- ---------------- function Initialize (Auth_Cid, Password : String) return Credential is use Ada.Strings; Result : Credential; -- The Strings will be truncated as necessary. Authentication -- will likely fail when the length of a credential exceeds a -- buffer size. begin pragma Assert (Auth_Cid'Length <= Result.Auth_Cid'Length and then Password'Length <= Result.Password'Length); Fixed.Move (Source => Auth_Cid, Target => Result.Auth_Cid, Drop => Right, Justify => Left, Pad => '#'); Result.Last_A := Positive'Min (Result.Auth_Cid'Length, Auth_Cid'Length); Fixed.Move (Source => Password, Target => Result.Password, Drop => Right, Justify => Left, Pad => '#'); Result.Last_P := Positive'Min (Result.Password'Length, Password'Length); return Result; end Initialize; end AWS.SMTP.Authentication.Plain;