xref: /curl/packages/OS400/rpg-examples/SMTPSRCMBR (revision 7c142d05)
1      * Curl SMTP send source member as attachment
2      *
3     h DFTACTGRP(*NO) ACTGRP(*NEW)
4     h OPTION(*NOSHOWCPY)
5     h BNDDIR('CURL')
6      *
7      **************************************************************************
8      *                                  _   _ ____  _
9      *  Project                     ___| | | |  _ \| |
10      *                             / __| | | | |_) | |
11      *                            | (__| |_| |  _ <| |___
12      *                             \___|\___/|_| \_\_____|
13      *
14      * Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
15      *
16      * This software is licensed as described in the file COPYING, which
17      * you should have received as part of this distribution. The terms
18      * are also available at https://curl.se/docs/copyright.html.
19      *
20      * You may opt to use, copy, modify, merge, publish, distribute and/or sell
21      * copies of the Software, and permit persons to whom the Software is
22      * furnished to do so, under the terms of the COPYING file.
23      *
24      * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF
25      * ANY KIND, either express or implied.
26      *
27      * SPDX-License-Identifier: curl
28      *
29      **************************************************************************
30      *
31      /include H,CURL.INC
32      *
33      * Example to SMTP send source member as attachment via SMTP.
34      *
35     fRPGXAMPLESif   e             disk    extmbr(program_name)
36     f                                     rename(RPGXAMPLES: record)
37     d                 pi
38     d url                           60                                         SMTP server URL
39     d recipient_mail                40                                         Recipient mail addr
40      *
41     d program_name    c                   'SMTPSRCMBR'                         Member name to send
42     d sender_name     c                   'Curl'                               Sender name
43     d sender_mail     c                   'curl@example.com'                   Sender e-mail
44     d recipient_name  c                   'WIMC'                               Recipient name
45     d crlf            c                   X'0D25'
46      *
47     d urllen          s             10u 0                                      URL length
48     d rcptmlen        s             10u 0                                      Recipient mail len
49      *
50      **************************************************************************
51
52        urllen = trimmed_length(url: %len(url));
53        rcptmlen = trimmed_length(recipient_mail: %len(recipient_mail));
54
55        // Do the curl stuff.
56
57        curl_global_init(CURL_GLOBAL_ALL);
58        main();
59        curl_global_cleanup();
60        *inlr = *on;            // Exit
61      *
62      **************************************************************************
63      * Main procedure: do the curl job.
64      **************************************************************************
65      *
66     p main            b
67     d main            pi
68      *
69     d h               s               *                                        Easy handle
70     d result          s                   like(CURLcode)                       Curl return code
71     d                                     inz(CURLE_OUT_OF_MEMORY)
72     d errmsgp         s               *                                        Error string pointer
73     d response        s             52                                         For error display
74     d headers         s               *   inz(*NULL)                           Mail headers
75     d rcpts           s               *   inz(*NULL)                           List of recipients
76     d mime            s               *                                        Mail MIME structure
77     d mimepart        s               *                                        Mail part
78
79            // Create and fill curl handle.
80
81        h = curl_easy_init();
82        if h <> *NULL;
83            rcpts = curl_slist_append_ccsid(rcpts:
84                                        %subst(recipient_mail: 1: rcptmlen): 0);
85            headers = curl_slist_append_ccsid(headers: 'From: ' + sender_name +
86                                                       ' <' + sender_mail + '>':
87                                              0);
88            headers = curl_slist_append_ccsid(headers: 'To: ' + recipient_name +
89                           ' <' + %subst(recipient_mail: 1: rcptmlen) + '>': 0);
90            headers = curl_slist_append_ccsid(headers: 'Subject: An ILE/RPG ' +
91                                              'source program': 0);
92            headers = curl_slist_append_ccsid(headers: 'Date: ' + mail_date():
93                                              0);
94            curl_easy_setopt_ccsid(h: CURLOPT_URL: %subst(url: 1: urllen): 0);
95            curl_easy_setopt_ccsid(h: CURLOPT_MAIL_FROM: sender_mail: 0);
96            curl_easy_setopt(h: CURLOPT_MAIL_RCPT: rcpts);
97            curl_easy_setopt(h: CURLOPT_HTTPHEADER: headers);
98            mime = curl_mime_init(h);
99            mimepart = curl_mime_addpart(mime);
100            curl_mime_data_ccsid(mimepart: 'Please find the ILE/RPG program ' +
101                                           program_name + ' source code in ' +
102                                           'attachment.' + crlf:
103                                 CURL_ZERO_TERMINATED: 0);
104            mimepart = curl_mime_addpart(mime);
105            curl_mime_data_cb(mimepart: -1: %paddr(out_data_cb): *NULL: *NULL:
106                              *NULL);
107            curl_mime_filename_ccsid(mimepart: program_name: 0);
108            curl_mime_encoder_ccsid(mimepart: 'quoted-printable': 0);
109            curl_easy_setopt(h: CURLOPT_MIMEPOST: mime);
110
111            // Perform the request.
112
113            setll *start RPGXAMPLES;
114            result = curl_easy_perform(h);
115
116            // Cleanup.
117
118            curl_mime_free(mime);
119            curl_slist_free_all(headers);
120            curl_slist_free_all(rcpts);
121            curl_easy_cleanup(h);       // Release handle
122        endif;
123
124        // Check for error and report if some.
125
126        if result <> CURLE_OK;
127            errmsgp = curl_easy_strerror_ccsid(result: 0);
128            response = %str(errmsgp);
129            dsply '' '*EXT' response;
130        else;
131            response = 'Mail sent';
132            dsply '' '*EXT' response;
133        endif;
134     p main            e
135      *
136      **************************************************************************
137      * Attachment data callback procedure.
138      **************************************************************************
139      *
140     p out_data_cb     b
141     d out_data_cb     pi            10u 0
142     d  ptr                            *   value                                Output data pointer
143     d  size                         10u 0 value                                Data element size
144     d  nmemb                        10u 0 value                                Data element count
145     d  userdata                       *   value                                User data pointer
146      *
147     d buffer          s        9999999    based(ptr)                           Output buffer
148     d line            s        9999999    based(lineptr)                       ASCII line pointer
149     d linelen         s             10u 0
150     d i               s             10u 0                                      Buffer position
151      *
152        size = size * nmemb;                                   // The size in bytes.
153        i = 0;
154        dow size - i >= %len(SRCDTA) + %len(crlf) and not %eof(RPGXAMPLES);
155            read record;
156            lineptr = curl_from_ccsid(%trimr(SRCDTA) + crlf: 0);
157            linelen = %scan(X'00': line) - 1;
158            %subst(buffer: i + 1: linelen) = %str(lineptr);
159            curl_free(lineptr);
160            i = i + linelen;
161        enddo;
162        return i;
163     p out_data_cb     e
164      *
165      **************************************************************************
166      * Mail-formatted date procedure.
167      **************************************************************************
168      *
169     p mail_date       b
170     d mail_date       pi            50    varying
171      *
172     d sysval          ds                  qualified                            To retrieve timezone
173     d  numsysval                    10u 0
174     d  offset                       10u 0
175     d                              100
176      *
177     d get_sysval      pr                  extpgm('QWCRSVAL')
178     d  outdata                            likeds(sysval)
179     d  outsize                      10u 0 const
180     d  numsysval                    10u 0 const
181     d  name                         10    const
182     d  errcode                   10000    options(*varsize)
183      *
184     d now             ds                  qualified
185     d  ts                             z
186     d  year                          4s 0 overlay(ts: 1)
187     d  month                         2s 0 overlay(ts: 6)
188     d  day                           2s 0 overlay(ts: 9)
189     d  hour                          2s 0 overlay(ts: 12)
190     d  minute                        2    overlay(ts: 15)
191     d  second                        2    overlay(ts: 18)
192      *
193     d sysvalinfo      ds                  qualified based(sysvalinfoptr)
194     d  name                         10
195     d  type                          1
196     d  status                        1
197     d  length                       10u 0
198     d  value                     99999
199      *
200     d qusec           ds                  qualified
201     d                               10u 0 inz(0)
202      *
203     d weekday         s             10u 0
204      *
205        now.ts = %timestamp(*SYS);
206        get_sysval(sysval: %len(sysval): 1: 'QUTCOFFSET': qusec);
207        sysvalinfoptr = %addr(sysval) + sysval.offset;
208        weekday = %rem(%diff(now.ts: %timestamp('2001-01-01-00.00.00.000000'):
209                                                *DAYS): 7);
210        return %subst('MonTueWedThuFriSatSun': 3 * weekday + 1: 3) + ', ' +
211               %char(now.day) + ' ' +
212               %subst('JanFebMarAprMayJunJulAugSepOctNovDec':
213                      3 * now.month - 2: 3) + ' ' +
214               %char(now.year) + ' ' +
215               %char(now.hour) + ':' + now.minute + ':' + now.second + ' ' +
216               %subst(sysvalinfo.value: 1: sysvalinfo.length);
217     p mail_date       e
218      *
219      **************************************************************************
220      * Get the length of right-trimmed string
221      **************************************************************************
222      *
223     p trimmed_length  b
224     d trimmed_length  pi            10u 0
225     d  string                   999999    const options(*varsize)
226     d  length                       10u 0 value
227      *
228     d addrdiff        s             10i 0
229     d len             s             10u 0
230      *
231        len = %scan(X'00': string: 1: length); // Limit to zero-terminated string
232        if len = 0;
233            len = length + 1;
234        endif;
235        if len <= 1;
236            return 0;
237        endif;
238        return %checkr(' ': string: len - 1);  // Trim right
239     p trimmed_length  e
240