PageRenderTime 49ms CodeModel.GetById 4ms app.highlight 40ms RepoModel.GetById 1ms app.codeStats 0ms

/src/yolk-email.adb

http://github.com/ThomasLocke/yolk
Ada | 744 lines | 488 code | 149 blank | 107 comment | 17 complexity | 93e280971700100cc9cfbb4f633a51b4 MD5 | raw file
  1-------------------------------------------------------------------------------
  2--                                                                           --
  3--                   Copyright (C) 2010-, Thomas Løcke                   --
  4--                                                                           --
  5--  This library is free software;  you can redistribute it and/or modify    --
  6--  it under terms of the  GNU General Public License  as published by the   --
  7--  Free Software  Foundation;  either version 3,  or (at your  option) any  --
  8--  later version. This library is distributed in the hope that it will be   --
  9--  useful, but WITHOUT ANY WARRANTY;  without even the implied warranty of  --
 10--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
 11--                                                                           --
 12--  As a special exception under Section 7 of GPL version 3, you are         --
 13--  granted additional permissions described in the GCC Runtime Library      --
 14--  Exception, version 3.1, as published by the Free Software Foundation.    --
 15--                                                                           --
 16--  You should have received a copy of the GNU General Public License and    --
 17--  a copy of the GCC Runtime Library Exception along with this program;     --
 18--  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
 19--  <http://www.gnu.org/licenses/>.                                          --
 20--                                                                           --
 21-------------------------------------------------------------------------------
 22
 23with Ada.Calendar;
 24with Ada.Directories;
 25with AWS.MIME;
 26with AWS.Utils;
 27with GNATCOLL.Email.Utils;
 28with GNATCOLL.VFS;
 29with Yolk.Utilities;
 30
 31package body Yolk.Email is
 32
 33   procedure Build_Attachments
 34     (ES    : in     Structure;
 35      Email : in out GNATCOLL.Email.Message);
 36   --  Add attachments to Email.
 37
 38   procedure Build_Bcc_Header
 39     (ES    : in     Structure;
 40      Email : in out GNATCOLL.Email.Message);
 41   --  Build the Bcc header and add it to Email.
 42
 43   procedure Build_Cc_Header
 44     (ES    : in     Structure;
 45      Email : in out GNATCOLL.Email.Message);
 46   --  Build the Cc header and add it to Email.
 47
 48   procedure Build_Content_Transfer_Encoding_Header
 49     (Charset : in     Character_Set;
 50      Email   : in out GNATCOLL.Email.Message);
 51   --  Build the Content-Transfer-Encoding header and add it to Email.
 52
 53   procedure Build_Content_Type_Header
 54     (ES    : in     Structure;
 55      Email : in out GNATCOLL.Email.Message;
 56      Kind  : in String);
 57   --  Build the Content-Type header and add it to Email.
 58
 59   procedure Build_Custom_Headers
 60     (ES    : in     Structure;
 61      Email : in out GNATCOLL.Email.Message);
 62   --  Build the custom headers. Custom headers are usually things like
 63   --  User-Agent, Organization or X - headers.
 64
 65   procedure Build_Date_Header
 66     (Email : in out GNATCOLL.Email.Message);
 67   --  Build the Date header and add it to Email.
 68
 69   procedure Build_Email_Data
 70     (Header : in out GNATCOLL.Email.Header;
 71      List   : in     Email_Data_Container.Vector);
 72   --  Construct the actual content for the sender/recipient headers, such as
 73   --  To, Cc, Bcc, Reply-To and so on.
 74
 75   procedure Build_From_Header
 76     (ES    : in     Structure;
 77      Email : in out GNATCOLL.Email.Message);
 78   --  Build the From header and add it to Email.
 79
 80   procedure Build_General_Headers
 81     (ES    : in     Structure;
 82      Email : in out GNATCOLL.Email.Message);
 83   --  Add the general headers such as To, From, Date and so on, to the Email.
 84
 85   procedure Build_MIME_Header
 86     (Email : in out GNATCOLL.Email.Message);
 87   --  Build the MIME-Version header and add it to Email.
 88
 89   procedure Build_Reply_To_Header
 90     (ES    : in     Structure;
 91      Email : in out GNATCOLL.Email.Message);
 92   --  Build the Reply-To header and add it to Email.
 93
 94   procedure Build_Sender_Header
 95     (ES    : in     Structure;
 96      Email : in out GNATCOLL.Email.Message);
 97   --  Build the Sender header and add it to Email.
 98
 99   procedure Build_Subject_Header
100     (ES    : in     Structure;
101      Email : in out GNATCOLL.Email.Message);
102   --  Build the Subject header and add it to Email.
103
104   procedure Build_To_Header
105     (ES    : in     Structure;
106      Email : in out GNATCOLL.Email.Message);
107   --  Build the To header and add it to Email.
108
109   function To_Virtual_File
110     (Item : in Attachment_Data)
111      return GNATCOLL.VFS.Virtual_File;
112   --  Convert an Attachment_Data.Path_To_File to a GNATCOLL.VFS Virtual_File.
113   --  Exceptions:
114   --    Attachment_File_Not_Found
115
116   -------------------------
117   --  Build_Attachments  --
118   -------------------------
119
120   procedure Build_Attachments
121     (ES    : in     Structure;
122      Email : in out GNATCOLL.Email.Message)
123   is
124      List : Attachments_Container.Vector renames ES.Attachment_List;
125   begin
126      for i in List.First_Index .. List.Last_Index loop
127         declare
128            use GNATCOLL.VFS;
129
130            Data : constant Attachment_Data := List.Element (i);
131            File : constant Virtual_File := To_Virtual_File (Item => Data);
132         begin
133            Email.Attach (Path        => File,
134                          MIME_Type   => AWS.MIME.Content_Type
135                            (Filename => To_String (Data.Path_To_File)),
136                          Charset     => Get_Charset (Data.Charset));
137         end;
138      end loop;
139   end Build_Attachments;
140
141   ------------------------
142   --  Build_Bcc_Header  --
143   ------------------------
144
145   procedure Build_Bcc_Header
146     (ES    : in     Structure;
147      Email : in out GNATCOLL.Email.Message)
148   is
149   begin
150      if not ES.Bcc_List.Is_Empty then
151         declare
152            use GNATCOLL.Email;
153
154            Bcc : Header := Create (Name  => "Bcc",
155                                    Value => "");
156         begin
157            Build_Email_Data (Header => Bcc,
158                              List   => ES.Bcc_List);
159
160            Email.Add_Header (H => Bcc);
161         end;
162      end if;
163   end Build_Bcc_Header;
164
165   -----------------------
166   --  Build_Cc_Header  --
167   -----------------------
168
169   procedure Build_Cc_Header
170     (ES    : in     Structure;
171      Email : in out GNATCOLL.Email.Message)
172   is
173   begin
174      if not ES.Cc_List.Is_Empty then
175         declare
176            use GNATCOLL.Email;
177
178            Cc : Header := Create (Name   => "Cc",
179                                   Value  => "");
180         begin
181            Build_Email_Data (Header => Cc,
182                              List   => ES.Cc_List);
183
184            Email.Add_Header (H => Cc);
185         end;
186      end if;
187   end Build_Cc_Header;
188
189   ----------------------------------------------
190   --  Build_Content_Transfer_Encoding_Header  --
191   ----------------------------------------------
192
193   procedure Build_Content_Transfer_Encoding_Header
194     (Charset : in     Character_Set;
195      Email   : in out GNATCOLL.Email.Message)
196   is
197      use GNATCOLL.Email;
198
199      CTE : Header;
200   begin
201      case Charset is
202         when US_ASCII =>
203            CTE := Create (Name  => Content_Transfer_Encoding,
204                           Value => "7bit");
205         when ISO_8859_1 .. Windows_1252 =>
206            CTE := Create (Name  => Content_Transfer_Encoding,
207                           Value => "quoted-printable");
208         when UTF8 =>
209            CTE := Create (Name  => Content_Transfer_Encoding,
210                           Value => "quoted-printable");
211      end case;
212
213      Email.Add_Header (H => CTE);
214   end Build_Content_Transfer_Encoding_Header;
215
216   ---------------------------------
217   --  Build_Content_Type_Header  --
218   ---------------------------------
219
220   procedure Build_Content_Type_Header
221     (ES    : in     Structure;
222      Email : in out GNATCOLL.Email.Message;
223      Kind  : in     String)
224   is
225      use GNATCOLL.Email;
226
227      CT : Header;
228   begin
229      CT := Create (Name   => Content_Type,
230                    Value  => Kind);
231      CT.Set_Param (Param_Name  => "charset",
232                    Param_Value => Get_Charset (ES.Text_Part.Charset));
233      Email.Add_Header (H => CT);
234   end Build_Content_Type_Header;
235
236   ----------------------------
237   --  Build_Custom_Headers  --
238   ----------------------------
239
240   procedure Build_Custom_Headers
241     (ES    : in     Structure;
242      Email : in out GNATCOLL.Email.Message)
243   is
244      use GNATCOLL.Email;
245
246      Data     : Header_Data;
247      Custom   : Header;
248
249      List : Custom_Headers_Container.Vector renames ES.Custom_Headers;
250   begin
251      for i in List.First_Index .. List.Last_Index loop
252         Data := List.Element (i);
253
254         Custom := Create (Name    => To_String (Data.Name),
255                           Value   => To_String (Data.Value),
256                           Charset => Get_Charset (Data.Charset));
257
258         Email.Add_Header (H => Custom);
259      end loop;
260   end Build_Custom_Headers;
261
262   -------------------------
263   --  Build_Date_Header  --
264   -------------------------
265
266   procedure Build_Date_Header
267     (Email : in out GNATCOLL.Email.Message)
268   is
269      use GNATCOLL.Email;
270      use GNATCOLL.Email.Utils;
271
272      Date : constant Header := Create
273        (Name  => "Date",
274         Value => Format_Date (Date => Ada.Calendar.Clock));
275   begin
276      Email.Add_Header (H => Date);
277   end Build_Date_Header;
278
279   ------------------------
280   --  Build_Email_Data  --
281   ------------------------
282
283   procedure Build_Email_Data
284     (Header : in out GNATCOLL.Email.Header;
285      List   : in     Email_Data_Container.Vector)
286   is
287      use Yolk.Utilities;
288
289      Data : Email_Data;
290   begin
291      for i in List.First_Index .. List.Last_Index loop
292         Data := List.Element (i);
293
294         if Is_Empty (Data.Address) then
295            raise No_Address_Set;
296         end if;
297
298         if Data.Name = "" then
299            Header.Append (Value   => To_String (Data.Address));
300         else
301            Header.Append (Value   => To_String (Data.Name),
302                           Charset => Get_Charset (Data.Charset));
303            Header.Append (Value => " <" & To_String (Data.Address) & ">");
304         end if;
305
306         if i /= List.Last_Index then
307            Header.Append (Value => ", ");
308         end if;
309      end loop;
310   end Build_Email_Data;
311
312   -------------------------
313   --  Build_From_Header  --
314   -------------------------
315
316   procedure Build_From_Header
317     (ES    : in     Structure;
318      Email : in out GNATCOLL.Email.Message)
319   is
320      use GNATCOLL.Email;
321
322      From : Header := Create (Name    => "From",
323                               Value   => "");
324   begin
325      Build_Email_Data (Header => From,
326                        List   => ES.From_List);
327
328      Email.Add_Header (H => From);
329   end Build_From_Header;
330
331   -----------------------------
332   --  Build_General_Headers  --
333   -----------------------------
334
335   procedure Build_General_Headers
336     (ES    : in     Structure;
337      Email : in out GNATCOLL.Email.Message)
338   is
339   begin
340      Build_Bcc_Header (ES    => ES,
341                        Email => Email);
342
343      Build_Cc_Header (ES    => ES,
344                       Email => Email);
345
346      Build_Custom_Headers (ES      => ES,
347                            Email   => Email);
348
349      Build_Date_Header (Email => Email);
350
351      Build_From_Header (ES    => ES,
352                         Email => Email);
353
354      Build_MIME_Header (Email => Email);
355
356      Build_Reply_To_Header (ES    => ES,
357                             Email => Email);
358
359      Build_Sender_Header (ES    => ES,
360                           Email => Email);
361
362      Build_Subject_Header (ES    => ES,
363                            Email => Email);
364
365      Build_To_Header (ES    => ES,
366                       Email => Email);
367   end Build_General_Headers;
368
369   -------------------------
370   --  Build_MIME_Header  --
371   -------------------------
372
373   procedure Build_MIME_Header
374     (Email : in out GNATCOLL.Email.Message)
375   is
376      use GNATCOLL.Email;
377
378      MIME : constant Header := Create (Name  => MIME_Version,
379                                        Value => "1.0");
380   begin
381      Email.Add_Header (H => MIME);
382   end Build_MIME_Header;
383
384   -----------------------------
385   --  Build_Reply_To_Header  --
386   -----------------------------
387
388   procedure Build_Reply_To_Header
389     (ES    : in     Structure;
390      Email : in out GNATCOLL.Email.Message)
391   is
392   begin
393      if not ES.Reply_To_List.Is_Empty then
394         declare
395            use GNATCOLL.Email;
396
397            Reply_To : Header := Create (Name   => "Reply-To",
398                                         Value  => "");
399         begin
400            Build_Email_Data (Header => Reply_To,
401                              List   => ES.Reply_To_List);
402
403            Email.Add_Header (H => Reply_To);
404         end;
405      end if;
406   end Build_Reply_To_Header;
407
408   ---------------------------
409   --  Build_Sender_Header  --
410   ---------------------------
411
412   procedure Build_Sender_Header
413     (ES    : in     Structure;
414      Email : in out GNATCOLL.Email.Message)
415   is
416   begin
417      if ES.Sender.Address /= Null_Unbounded_String then
418         declare
419            use GNATCOLL.Email;
420
421            Sender : Header;
422         begin
423            if ES.Sender.Name = "" then
424               Sender := Create (Name    => "Sender",
425                                 Value   => To_String (ES.Sender.Address),
426                                 Charset => Get_Charset (ES.Sender.Charset));
427            else
428               Sender := Create (Name    => "Sender",
429                                 Value   => To_String (ES.Sender.Name),
430                                 Charset => Get_Charset (ES.Sender.Charset));
431               Sender.Append
432                 (Value   => " <" & To_String (ES.Sender.Address) & ">");
433            end if;
434
435            Email.Add_Header (H => Sender);
436         end;
437      else
438         if ES.From_List.Length > 1 then
439            raise No_Sender_Set_With_Multiple_From;
440         end if;
441      end if;
442   end Build_Sender_Header;
443
444   ----------------------------
445   --  Build_Subject_Header  --
446   ----------------------------
447
448   procedure Build_Subject_Header
449     (ES    : in     Structure;
450      Email : in out GNATCOLL.Email.Message)
451   is
452      use GNATCOLL.Email;
453
454      Subject  : constant Header := Create
455        (Name    => "Subject",
456         Value   => To_String (ES.Subject.Content),
457         Charset => Get_Charset (ES.Subject.Charset));
458   begin
459      Email.Add_Header (H => Subject);
460   end Build_Subject_Header;
461
462   -------------------------
463   --  Build_To_Header  --
464   -------------------------
465
466   procedure Build_To_Header
467     (ES    : in     Structure;
468      Email : in out GNATCOLL.Email.Message)
469   is
470      use GNATCOLL.Email;
471
472      To : Header := Create (Name   => "To",
473                             Value  => "");
474   begin
475      Build_Email_Data (Header => To,
476                        List   => ES.To_List);
477
478      Email.Add_Header (H => To);
479   end Build_To_Header;
480
481   ------------------------------------
482   --  Generate_Text_And_HTML_Email  --
483   ------------------------------------
484
485   procedure Generate_Text_And_HTML_Email
486     (ES : in out Structure)
487   is
488      use GNATCOLL.Email;
489
490      Email          : Message := New_Message (Multipart_Alternative);
491      HTML_Payload   : Message := New_Message (Text_Html);
492      Text_Payload   : Message := New_Message (Text_Plain);
493   begin
494      Email.Set_Boundary (Boundary => AWS.Utils.Random_String (16));
495
496      Text_Payload.Set_Text_Payload
497        (Payload   => To_String (ES.Text_Part.Content),
498         Charset   => Get_Charset (ES.Text_Part.Charset));
499
500      Text_Payload.Delete_Headers (Name => "");
501
502      Build_Content_Transfer_Encoding_Header (Charset => ES.Text_Part.Charset,
503                                              Email   => Text_Payload);
504
505      Build_Content_Type_Header (ES    => ES,
506                                 Email => Text_Payload,
507                                 Kind  => Text_Plain);
508
509      HTML_Payload.Set_Text_Payload
510        (Payload   => To_String (ES.HTML_Part.Content),
511         Charset   => Get_Charset (ES.HTML_Part.Charset));
512
513      HTML_Payload.Delete_Headers (Name => "");
514
515      Build_Content_Transfer_Encoding_Header (Charset => ES.HTML_Part.Charset,
516                                              Email   => HTML_Payload);
517
518      Build_Content_Type_Header (ES    => ES,
519                                 Email => HTML_Payload,
520                                 Kind  => Text_Html);
521
522      Email.Add_Payload (Payload => Text_Payload,
523                         First   => True);
524
525      Email.Add_Payload (Payload => HTML_Payload,
526                         First   => False);
527
528      Email.Set_Preamble
529        (Preamble => "This is a multi-part message in MIME format.");
530
531      Build_General_Headers (ES    => ES,
532                             Email => Email);
533
534      ES.Composed_Message := Email;
535   end Generate_Text_And_HTML_Email;
536
537   ----------------------------------------------------
538   --  Generate_Text_And_HTML_With_Attachment_Email  --
539   ----------------------------------------------------
540
541   procedure Generate_Text_And_HTML_With_Attachment_Email
542     (ES : in out Structure)
543   is
544      use GNATCOLL.Email;
545
546      Email_Alt      : Message := New_Message (Multipart_Alternative);
547      Email_Mixed    : Message := New_Message (Multipart_Mixed);
548      HTML_Payload   : Message := New_Message (Text_Html);
549      Text_Payload   : Message := New_Message (Text_Plain);
550   begin
551      Email_Alt.Set_Boundary (Boundary => AWS.Utils.Random_String (16));
552      Email_Mixed.Set_Boundary (Boundary => AWS.Utils.Random_String (16));
553
554      Text_Payload.Set_Text_Payload
555        (Payload   => To_String (ES.Text_Part.Content),
556         Charset   => Get_Charset (ES.Text_Part.Charset));
557
558      Text_Payload.Delete_Headers (Name => "");
559
560      Build_Content_Transfer_Encoding_Header (Charset => ES.Text_Part.Charset,
561                                              Email   => Text_Payload);
562
563      Build_Content_Type_Header (ES    => ES,
564                                 Email => Text_Payload,
565                                 Kind  => Text_Plain);
566
567      HTML_Payload.Set_Text_Payload
568        (Payload   => To_String (ES.HTML_Part.Content),
569         Charset   => Get_Charset (ES.HTML_Part.Charset));
570
571      HTML_Payload.Delete_Headers (Name => "");
572
573      Build_Content_Transfer_Encoding_Header (Charset => ES.HTML_Part.Charset,
574                                              Email   => HTML_Payload);
575
576      Build_Content_Type_Header (ES    => ES,
577                                 Email => HTML_Payload,
578                                 Kind  => Text_Html);
579
580      Email_Alt.Add_Payload (Payload => Text_Payload,
581                             First   => True);
582
583      Email_Alt.Add_Payload (Payload => HTML_Payload,
584                             First   => False);
585
586      Email_Mixed.Add_Payload (Payload => Email_Alt,
587                               First   => True);
588
589      Build_Attachments (ES    => ES,
590                         Email => Email_Mixed);
591
592      Email_Mixed.Set_Preamble
593        (Preamble => "This is a multi-part message in MIME format.");
594
595      Build_General_Headers (ES    => ES,
596                             Email => Email_Mixed);
597
598      ES.Composed_Message := Email_Mixed;
599   end Generate_Text_And_HTML_With_Attachment_Email;
600
601   ---------------------------
602   --  Generate_Text_Email  --
603   ---------------------------
604
605   procedure Generate_Text_Email
606     (ES : in out Structure)
607   is
608      use GNATCOLL.Email;
609
610      Email : Message := New_Message (MIME_Type => Text_Plain);
611   begin
612      Email.Set_Text_Payload
613        (Payload   => To_String (ES.Text_Part.Content),
614         Charset   => Get_Charset (ES.Text_Part.Charset));
615
616      Email.Delete_Headers (Name => "");
617
618      Build_General_Headers (ES    => ES,
619                             Email => Email);
620
621      Build_Content_Transfer_Encoding_Header (Charset => ES.Text_Part.Charset,
622                                              Email   => Email);
623
624      Build_Content_Type_Header (ES    => ES,
625                                 Email => Email,
626                                 Kind  => Text_Plain);
627
628      ES.Composed_Message := Email;
629   end Generate_Text_Email;
630
631   -------------------------------------------
632   --  Generate_Text_With_Attachment_Email  --
633   -------------------------------------------
634
635   procedure Generate_Text_With_Attachment_Email
636     (ES : in out Structure)
637   is
638      use GNATCOLL.Email;
639
640      Email          : Message := New_Message (MIME_Type => Multipart_Mixed);
641      Text_Payload   : Message := New_Message (MIME_Type => Text_Plain);
642   begin
643      Email.Set_Boundary (Boundary => AWS.Utils.Random_String (16));
644
645      Text_Payload.Set_Text_Payload
646        (Payload   => To_String (ES.Text_Part.Content),
647         Charset   => Get_Charset (ES.Text_Part.Charset));
648
649      Text_Payload.Delete_Headers (Name => "");
650
651      Build_Content_Transfer_Encoding_Header (Charset => ES.Text_Part.Charset,
652                                              Email   => Text_Payload);
653
654      Build_Content_Type_Header (ES    => ES,
655                                 Email => Text_Payload,
656                                 Kind  => Text_Plain);
657
658      Email.Add_Payload (Payload => Text_Payload,
659                         First   => True);
660
661      Build_Attachments (ES    => ES,
662                         Email => Email);
663
664      Email.Set_Preamble
665        (Preamble => "This is a multi-part message in MIME format.");
666
667      Build_General_Headers (ES    => ES,
668                             Email => Email);
669
670      ES.Composed_Message := Email;
671   end Generate_Text_With_Attachment_Email;
672
673   -------------------
674   --  Get_Charset  --
675   -------------------
676
677   function Get_Charset
678     (Charset : in Character_Set)
679      return String
680   is
681   begin
682      case Charset is
683         when US_ASCII => return GNATCOLL.Email.Charset_US_ASCII;
684         when ISO_8859_1 => return GNATCOLL.Email.Charset_ISO_8859_1;
685         when ISO_8859_2 => return GNATCOLL.Email.Charset_ISO_8859_2;
686         when ISO_8859_3 => return GNATCOLL.Email.Charset_ISO_8859_3;
687         when ISO_8859_4 => return GNATCOLL.Email.Charset_ISO_8859_4;
688         when ISO_8859_9 => return GNATCOLL.Email.Charset_ISO_8859_9;
689         when ISO_8859_10 => return GNATCOLL.Email.Charset_ISO_8859_10;
690         when ISO_8859_13 => return GNATCOLL.Email.Charset_ISO_8859_13;
691         when ISO_8859_14 => return GNATCOLL.Email.Charset_ISO_8859_14;
692         when ISO_8859_15 => return GNATCOLL.Email.Charset_ISO_8859_15;
693         when Windows_1252 => return GNATCOLL.Email.Charset_Windows_1252;
694         when UTF8 => return GNATCOLL.Email.Charset_UTF_8;
695      end case;
696   end Get_Charset;
697
698   -------------------------
699   --  Set_Type_Of_Email  --
700   -------------------------
701
702   procedure Set_Type_Of_Email
703     (ES : in out Structure)
704   is
705   begin
706      if not ES.Has_Text_Part then
707         ES.Text_Part.Content := U ("");
708      end if;
709      ES.Type_Of_Email := Text;
710
711      if ES.Has_HTML_Part then
712         ES.Type_Of_Email := Text_And_HTML;
713      end if;
714
715      if ES.Has_Attachment then
716         if ES.Type_Of_Email = Text then
717            ES.Type_Of_Email := Text_With_Attachment;
718         elsif ES.Type_Of_Email = Text_And_HTML then
719            ES.Type_Of_Email := Text_And_HTML_With_Attachment;
720         end if;
721      end if;
722   end Set_Type_Of_Email;
723
724   -----------------------
725   --  To_Virtual_File  --
726   -----------------------
727
728   function To_Virtual_File
729     (Item : in Attachment_Data)
730      return GNATCOLL.VFS.Virtual_File
731   is
732      use Ada.Directories;
733      use GNATCOLL.VFS;
734
735      Path_To_File : constant String := To_String (Item.Path_To_File);
736   begin
737      if not Exists (Path_To_File) then
738         raise Attachment_File_Not_Found;
739      end if;
740
741      return Locate_On_Path (Filesystem_String (Path_To_File));
742   end To_Virtual_File;
743
744end Yolk.Email;