IBM i UDTF to return DCM application assignments - E&OE - read and understand before you implement!

certsumm.clle

/* Example program to collate certificate information with application information */
pgm

dcl &sys *char 8
dcl &ccsid *dec (5 0)
dcl &sql *char 5000

/* Because reasons... */
rtvjoba ccsid(&ccsid)
chgjob ccsid(37)

/* Create a temporary table with the certificate info */
chgvar &sql ('+
create table qgpl/certinfo as ( +
with pwds as ( +
  select data_area_value as pw +
    from table(qsys2.data_area_info( +
                 data_area_name => ''SYSCERTPW'', +
                 data_area_library => ''QGPL'')) +
), +
certs as ( +
  select certificate_label, validity_end, trusted, ip_addresses, +
         domain_names, subject_common_name, issuer_common_name, +
         timestampdiff(16, char(validity_end - now())) as days_to_run, +
         timestampdiff(64, char(validity_end - now())) as months_to_run, +
         timestampdiff(256, char(validity_end - now())) as years_to_run, +
         case when private_key = ''NO'' then ''CA'' +
              else ''SERVER'' end as certificate_type +
    from table(certificate_info( +
                 certificate_store_password => (select pw from pwds))) x +
), +
roots as ( +
  select * from certs where subject_common_name = issuer_common_name +
                         or issuer_common_name is null +
), +
sorted as ( +
  select distinct c.*, +
         cast(sys_connect_by_path(c.subject_common_name, ''/'') +
          as varchar(250)) as cert_path +
    from certs c, roots r +
    start with c.subject_common_name = r.subject_common_name +
    connect by nocycle prior c.subject_common_name = c.issuer_common_name +
  union +
  select c.*, '''' as cert_path from certs c +
    where subject_common_name is null +
), +
sorted2 as ( +
  select * from sorted where +
   issuer_common_name is null or locate(issuer_common_name, cert_path) > 0 +
), +
usage as (select * from table( dcm_application_info() ) y)')
chgvar &sql (&sql |> '+
select char(o.validity_end) as validity_end, +
       case +
         when o.days_to_run < -30 then ''EXPIRED'' +
         when o.days_to_run < 0 then ''RECENTLY EXPIRED'' +
         when o.days_to_run = 0 then ''EXPIRES TODAY!'' +
         when o.days_to_run <= 14 then ''RENEW NOW!'' +
         when o.days_to_run <= 30 then ''TIME TO RENEW'' +
         when o.days_to_run <= 90 then +
              trim(char(days_to_run)) || '' days'' +
         when o.months_to_run <= 18 then +
              trim(char(o.months_to_run)) || '' months'' +
         else trim(char(o.years_to_run)) || '' years'' +
       end as status, o.subject_common_name, o.certificate_type, +
       regexp_replace(trim(cert_path), ''/[^/]+?$'','''',1,1) as provenance, +
       o.certificate_label, o.trusted, o.ip_addresses, +
       o.domain_names, u.application_id +
  from sorted2 o left join usage u +
       on o.certificate_label = u.certificate_id +
 order by cert_path, application_id +
) with data')
runsql sql(&sql) commit(*none)

/* OPTIONAL: This statement updates the data to be more human-friendly. */
chgvar &sql ('+
update qgpl/certinfo p +
  set validity_end = '''', status = '''', subject_common_name = '''', +
      certificate_type = '''', provenance = '''', certificate_label = '''', +
      trusted = '''', ip_addresses = '''', domain_names = '''' +
  where ( +
    select count(*) from qgpl/certinfo s +
      where s.certificate_label = p.certificate_label and +
            s.application_id < p.application_id) > 0+
')
runsql sql(&sql) commit(*none)

chgvar &sql ('+
label on column qgpl/certinfo ( +
  validity_end        is ''Valid               Until'', +
  status              is ''Status'', +
  subject_common_name is ''Subject             CN'', +
  provenance          is ''Provenance'', +
  application_id      is ''Application         ID'', +
  certificate_label   is ''Certificate         Label'', +
  certificate_type    is ''Certificate         Type'', +
  trusted             is ''Trusted?'', +
  ip_addresses        is ''IP                  Addresses'', +
  domain_names        is ''Domain              Names'' +
)+
')
runsql sql(&sql) commit(*none)

/* You can now use QGPL/CERTINFO to assess the certificate expiry dates with respect to applications assigned. */
/* E.g. send an email with the data attached or embedded. */

/* Clean up */
dltf qgpl/certinfo
chgjob ccsid(&ccsid)
endpgm

dcmapp.rpgle

**FREE
// RPG program that does the work of the UDTF
// CRTMOD, then
// CRTPGM PGM(QGPL/DCMAPP) BNDSRVPGM((QICSS/QYCDCUSG))

// PROCEDURE INTERFACE ------------------------------
dcl-pi dcmapp;
  // No input parameters
  // Returned columns
  p_applicationID                varchar(100);
  p_applicationDescription       varchar(330);
  p_certificateStore             varchar(14);
  p_certificateID                varchar(100);
  // Null indicators for input parms and columns
  p_null_applicationID           int(5);
  p_null_applicationDescription  int(5);
  p_null_certificateStore        int(5);
  p_null_certificateID           int(5);
  // SQL management
  p_sqlState                     char(5);
  p_sqlQualifiedFunction         varchar(139) const;
  p_sqlSpecifiedFunction         varchar(128) const;
  p_sqlError                     varchar(70);
  p_sqlScratchpad                likeds(sqlScratchpad);
  p_sqlCallType                  int(10) const;
end-pi;

// PROTOTYPES ---------------------------------------
// Retrieve Certificate Usage Info
dcl-pr getApps extproc('QycdRetrieveCertUsageInfo');
  *n  char(16384) const options(*varsize);  // Receiver
  *n  int(10) const;                        // Receiver length
  *n  char(8) const;                        // Format
  *n  char(21) const options(*varsize);     // Selection criteria
  *n  like(ERRC0100) options(*varsize);     // Error block
end-pr;

// Create user space
dcl-pr crtUsrSpc extpgm('QUSCRTUS');
  *n  like(qualifiedName) const;  // Qualified name
  *n  char(10) const;        // Attribute
  *n  int(10) const;         // Size
  *n  char(1) const;         // Init
  *n  char(10) const;        // Authority
  *n  char(50) const;        // Description
  *n  char(10) const;        // Replace?
  *n  like(ERRC0100);        // Error
end-pr;

// Change user space
dcl-pr chgUsrSpc extpgm('QUSCHGUS');
  *n  like(qualifiedName) const;  // Qualified name
  *n  int(10) const;         // Position
  *n  int(10) const;         // Length
  *n  char(16384) const;     // Data
  *n  char(1) const;         // Force to disk
  *n  like(ERRC0100);        // Error
end-pr;

// Retrieve pointer to user space
dcl-pr rtvUsrSpcPtr extpgm('QUSPTRUS');
  *n  like(qualifiedName) const;  // Qualified name
  *n  pointer;               // Pointer to space
  *n  like(ERRC0100);        // Error
end-pr;

dcl-pr dltUsrSpc extpgm('QUSDLTUS');
  *n  like(qualifiedName) const;  // Qualified name
  *n  like(ERRC0100);        // Error
end-pr;

// DATA ---------------------------------------------
dcl-ds criteria;  // Selection criteria for applications
  quantity          int(10) inz(1);     // Number of criteria
  entrySize         int(10) inz(17);    // Entry size
  operator          int(10) inz(1);     // Equal
  key               int(10) inz(2);     // Application type
  comparisonLength  int(10) inz(1);     // Comparison data length
  comparisonData    char(10) inz('1');  // Type = Server
end-ds;

dcl-ds ERRC0100 qualified;  // Standard API error block
  bytesProvided   int(10) inz(%size(ERRC0100));
  bytesAvailable  int(10);
  messageID       char(7);
  reserved        char(1);
  messageData     char(128);
end-ds;

dcl-ds RCUI0200 qualified;  // RCUI0200 return format
  bytesReturned    int(10);
  bytesAvailable   int(10);
  firstOffset      int(10);
  numberOfEntries  int(10);
  theData          char(16368);
end-ds;

dcl-ds RCUI0200p based(usrSpcPtr) likeds(RCUI0200);

dcl-ds appEntry len(1024) qualified based(entry_loc);
  displacementToNext       int(10)   pos(1);
  applicationID            char(100) pos(5);
  certificateAssigned      char(1)   pos(207);
  certificateIDType        char(1)   pos(208);
  numberOfCertificates     int(5)    pos(211);
  certificateDisplacement  int(10)   pos(213);
  certificateLength        int(10)   pos(217);
  storeDisplacement        int(10)   pos(225);
  storeLength              int(10)   pos(229);
  applicationDescription   char(330) pos(251);
end-ds;

dcl-ds qualifiedName;  // Qualified user space name
  name    char(10) inz('DCM_APPS');
  library char(10) inz('QGPL');
end-ds;

// Template for scratchPad parameter
dcl-ds sqlScratchpad len(32) template qualified;
  length              int(5);
  currentEntry        int(10);
  currentCertificate  int(10);
  currentOffset       int(10);
end-ds;

// Variables to handle multi-certificate entries
dcl-s mcOffset  int(5);
dcl-s mcX       int(5);
dcl-s mcLength  int(5) based(mcPointer);

// SQL constants
// UDTF Call Type parameter values
dcl-c CALL_FIRST  -2;             
dcl-c CALL_OPEN   -1;             
dcl-c CALL_FETCH   0;             
dcl-c CALL_CLOSE   1;             
dcl-c CALL_FINAL   2;             
                                  
// UDTF null indicators           
dcl-c PARM_NULL   -1;             
dcl-c PARM_NOTNULL 0;             

// UDTF EOF
dcl-c RTN_EOF '02000';

select;
  when p_sqlCallType = CALL_OPEN;
    // Call the API to fetch the info for all apps
    getApps(RCUI0200: %size(RCUI0200): 'RCUI0200': criteria: ERRC0100);
    // Store the results in a user space for later
    crtUsrSpc(qualifiedName: 'RCUI0200': 16384: x'00': '*CHANGE': '': '*YES': ERRC0100);
    chgUsrSpc(qualifiedName: 1: 16384: RCUI0200: '0': ERRC0100);
    // Store first entry to return in SQL scratchpad
    p_sqlScratchpad.currentEntry = 1;
    p_sqlScratchpad.currentCertificate = 1;
    p_sqlScratchpad.currentOffset = RCUI0200.firstOffset;

  when p_sqlCallType = CALL_FETCH;
    // Get a pointer to the user space
    rtvUsrSpcPtr(qualifiedName: usrSpcPtr: ERRC0100);
    // Extract the next entry
    entry_loc = usrSpcPtr + p_sqlScratchpad.currentOffset; // Align app_entry to the current entry
    p_applicationID = appEntry.applicationID;
    p_null_applicationID = PARM_NOTNULL;
    p_applicationDescription = appEntry.applicationDescription;
    p_null_applicationDescription = PARM_NOTNULL;
    p_certificateStore = %str(entry_loc + appEntry.storeDisplacement);
    if p_certificateStore = '';
      p_null_certificateStore = PARM_NULL;
    else;
      p_null_certificateStore = PARM_NOTNULL;
    endif;

    if appEntry.certificateAssigned = '0'; // No certificates
      p_certificateID = '';
      p_null_certificateID = PARM_NULL;
    else; // One or more certificates
      if appEntry.certificateIDType = '1'; // A single certificate
        p_certificateID = %str(entry_loc + appEntry.certificateDisplacement);
        p_null_certificateID = PARM_NOTNULL;
      else; // Multiple certificates
        mcOffset = 0;
        mcPointer = entry_loc + appEntry.certificateDisplacement;
        if p_sqlScratchpad.currentEntry > 1;
          for mcX = 2 to p_sqlScratchpad.currentEntry;
            mcPointer = entry_loc + appEntry.certificateDisplacement + mcOffset;
            mcOffset += mcLength + 2;
            mcPointer = entry_loc + appEntry.certificateDisplacement + mcOffset;
          endfor;
        endif;
        p_certificateID =
          %str(entry_loc + appEntry.certificateDisplacement + mcOffset + 2: mcLength);
      endif;
    endif;

    // Increment for next pass or signal EOF
    p_sqlScratchpad.currentEntry += 1;
    if p_sqlScratchpad.currentEntry > appEntry.numberOfCertificates;
      p_sqlScratchpad.currentEntry = 1;
      p_sqlScratchpad.currentCertificate += 1;
      p_sqlScratchpad.currentOffset += appEntry.displacementToNext;
      if p_sqlScratchpad.currentCertificate > RCUI0200p.numberOfEntries;
        p_sqlState = RTN_EOF; // Signal end of file
      endif;
    endif;

  other; // CLOSE
    *inlr = *on;

endsl;

return;

dcmapp.sql

// Create a UDTF that can be used to query application information 
create or replace function qgpl/dcm_application_info
  ( )
  returns table
  ( application_id varchar(100), application_description varchar(330),
    certificate_store varchar(14), certificate_id varchar(100) )
  external name 'QGPL/DCMAPP'
  program type main
  language rpgle
  parameter style sql
  no sql
  not deterministic
  scratchpad 32
  no final call
  external action
  disallow parallel;